pure-noise 0.1.0.1 → 0.2.1.1
raw patch · 25 files changed
Files
- CHANGELOG.md +65/−0
- README.md +158/−37
- bench/Bench.hs +391/−185
- bench/BenchLib.hs +0/−0
- pure-noise.cabal +41/−13
- src/Numeric/Noise.hs +173/−43
- src/Numeric/Noise/Cellular.hs +136/−73
- src/Numeric/Noise/Fractal.hs +142/−36
- src/Numeric/Noise/Internal.hs +342/−121
- src/Numeric/Noise/Internal/Math.hs +147/−32
- src/Numeric/Noise/OpenSimplex.hs +42/−61
- src/Numeric/Noise/Perlin.hs +16/−10
- src/Numeric/Noise/SuperSimplex.hs +22/−51
- src/Numeric/Noise/Value.hs +4/−6
- src/Numeric/Noise/ValueCubic.hs +4/−6
- test/CellularSpec.hs +37/−0
- test/FractalSpec.hs +68/−0
- test/Golden/Util.hs +393/−0
- test/Noise2Spec.hs +2/−8
- test/Noise3Spec.hs +3/−4
- test/OpenSimplexSpec.hs +21/−0
- test/PerlinSpec.hs +29/−2
- test/SuperSimplexSpec.hs +19/−0
- test/ValueCubicSpec.hs +27/−0
- test/ValueSpec.hs +29/−0
CHANGELOG.md view
@@ -8,6 +8,71 @@ ## Unreleased +## 0.2.1.1 2025-10-31++### Changed++- Fixed some errata in the documentation++## 0.2.1.0 2025-10-31++### Added++- 1D noise support with `noise1At` evaluation function+- Noise slicing functions (`sliceX2`, `sliceY2`, `sliceX3`, `sliceY3`, `sliceZ3`) for reducing noise dimensionality+- Comprehensive Haddock documentation for:+ - Core `Noise p v` type with usage examples+ - All utility functions (`warp`, `reseed`, `remap`, `blend`)+ - All slicing functions with examples+- Exported utility functions:+ - `warp` - transform coordinate space+ - `reseed` - modify seed for independent layers (generalizes `alterSeed2`/`alterSeed3`)+ - `remap` - transform noise values (alias for `fmap`)+ - `blend` - combine noise functions with custom blending (alias for `liftA2`)+- Exported `Noise` type for advanced usage and type annotations++### Changed++- Refactored to unified noise representation using `newtype Noise p v`+ - `Noise2` and `Noise3` are now type aliases: `Noise (a,a) a` and `Noise (a,a,a) a`+ - Provides `Functor`, `Applicative`, `Monad`, `Num`, `Fractional`, and `Floating` instances+ - All dimensions share the same instance implementations for consistency+- Updated module documentation with examples of new features (slicing, warping, layering)+- Improved README with advanced usage examples++### Performance++- **Overall**: 90% of benchmarks improved with +32.4% average performance gain+- **Ping-pong fractals**: Branchless optimization yields 110-148% improvement (perlin, value, openSimplex)+- **Cellular noise**: REWRITE RULES for gradient lookups provide 61-70% improvement+- **3D ValueCubic fractals**: Fixed performance regression, achieving 45-80% improvement+- **Perlin noise**: 10-63% improvements from optimized lerp/cubic interpolation with REWRITE RULES+- **Value noise**: 11-43% improvements from interpolation optimizations+- **OpenSimplex2**: 6-16% improvement for Float; minor regression (~5%) for Double variants+- **SuperSimplex2**: Shows 3-21% regression due to improved benchmark methodology+ - Previous benchmarks used same X/Y offset (diagonal sampling), which favored SuperSimplex's triangular lattice+ - New benchmarks use independent X/Y offsets for realistic 2D coordinate distributions+ - Algorithm remains functionally correct; numbers now reflect true 2D performance++## 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
README.md view
@@ -2,75 +2,196 @@ Performant, modern noise generation for Haskell with a minimal dependency footprint. -The algorithms used in this library are ported from [FastNoiseLite](https://github.com/Auburn/FastNoiseLite). The library structure has been retuned to fit better with Haskell semantics.+## Core features -The public interface for this library is unlikely to change much, although the implementations (`noiseBaseN` functions and anything in `Numeric.Noise.Internal`) are subject to change and may change between minor versions.+- **algebraic composition** of noise functions. You can combine,+ layer, and transform noise sources using standard operators (E.g., `Num`,+ `Fractional`, `Monad`, etc).+- **Complex effects** like domain warping and multi-octave fractals with clean,+ type-safe composition.+- **84-95% of C++ FastNoiseLite performance** through aggressive optimization and+ LLVM compilation. +**For detailed FastNoiseLite comparison, methodology, and reproducibility instructions,+see the [benchmark README](https://github.com/jtnuttall/pure-noise/blob/main/bench/README.md).**++The public interface for this library is unlikely to change much, although the+implementations (`noiseBaseN` functions and anything in `Numeric.Noise.Internal`)+are subject to change and may change between minor versions.++## Acknowledgments++- This project grew from a port of the excellent+ [FastNoiseLite](https://github.com/Auburn/FastNoiseLite) library. The library+ structure has been tuned to perform well in Haskell and fit well with Haskell+ semantics, but the core noise implementations are the same.+- All credit for the original design, algorithms, and implementation goes to its+ creator **[Jordan Peck (@Auburn)](https://github.com/Auburn)**. I'm grateful for+ their work and the opportunity to learn from it.+- The original FastNoiseLite code, from which the core algorithms in this library+ were originally ported, is (C) 2020 Jordan Peck and is licensed under the MIT+ license, a copy of which is included in this repository.+ ## Usage -The library exports newtypes for N-dimensional noise. Currently, these are just functions that accept a seed and a point in N-dimensional space. They can be arbitrarily unwrapped by with the `noiseNAt` family of functions. Since they abstract over the given seed and parameters, they can be composed with `Num` or `Fractional` methods at will with little-to-no performance cost.+The library provides composable noise functions. `Noise2` and `Noise3` are type+aliases for 2D and 3D noise. Noise functions can be composed transparently using+standard operators with minimal performance cost. -Noise values are generally clamped to `[-1, 1]`, although some noise functions may occasionally produce values slightly outside this range.+Noise values are generally clamped to `[-1, 1]`, although some noise functions+may occasionally produce values slightly outside this range. +### Basic Example+ ```haskell import Numeric.Noise qualified as Noise -myNoise2 :: (RealFrac a) => Seed -> a -> a -> a+-- Compose multiple noise sources+myNoise2 :: (RealFrac a) => Noise.Seed -> a -> a -> a myNoise2 = let fractalConfig = Noise.defaultFractalConfig- in Noise.noise2At $- Noise.fractal2 fractalConfig ((perlin2 + superSimplex2) / 2)+ combined = (Noise.perlin2 + Noise.superSimplex2) / 2+ in Noise.noise2At $ Noise.fractal2 fractalConfig combined ``` +### Advanced Features++The library's unified `Noise p v` type enables powerful composition patterns:++#### Complex Compositions++The `Monad` instance is useful to create noise that depends on other noise values:++```haskell+-- Use one noise function's output to modulate another+complexNoise :: Noise.Noise2 Float+complexNoise = do+ baseNoise <- Noise.perlin2+ detailNoise <- Noise.next2 Noise.superSimplex2+ -- Blend based on base noise: smooth areas get less detail+ pure $ baseNoise * 0.7 + detailNoise * (0.3 * (1 + baseNoise) / 2)+```++This is especially useful for creating organic, varied terrain where one noise pattern+influences the characteristics of another.++#### 1D Noise via Slicing++Generate 1D noise by slicing higher-dimensional noise at a fixed coordinate:++```haskell+-- Create 1D noise by fixing one dimension+noise1d :: Noise.Noise1 Float+noise1d = Noise.sliceY2 0.0 Noise.perlin2++-- Evaluate at a point+value = Noise.noise1At noise1d seed 5.0+```++**Coordinate Transformation:**++Scale, rotate, or warp the coordinate space:++```haskell+-- Double the frequency+scaled = Noise.warp (\(x, y) -> (x * 2, y * 2)) Noise.perlin2++-- Rotate 45 degrees+rotated = Noise.warp (\(x, y) ->+ let a = pi / 4+ in (x * cos a - y * sin a, x * sin a + y * cos a)) Noise.perlin2+```++#### Layering Independent Noise++Use `reseed` or `next2`/`next3` to create independent layers:++```haskell+layered = (Noise.perlin2 + Noise.next2 Noise.perlin2) / 2+```+ More examples can be found in `bench` and `demo`. +#### Domain Warping++Domain warping uses one noise function to distort the coordinate space of another,+creating organic, flowing patterns ideal for terrain, clouds, and natural textures:++```haskell+domainWarped :: Noise.Noise2 Float+domainWarped = do+ -- Generate 3D fractal for warp offsets+ let warpNoise = Noise.fractal3 Noise.defaultFractalConfig{Noise.octaves = 5} Noise.perlin3+ -- Sample 3D noise at different slices to create warp offsets+ warpX <- Noise.sliceX3 0.0 warpNoise -- Samples at (0, x, y)+ warpY <- Noise.sliceY3 0.0 warpNoise -- Samples at (x, 0, y)+ -- Apply warping to base noise coordinates+ Noise.warp (\(x, y) -> (x + 30 * warpX, y + 30 * warpY))+ $ Noise.fractal2 Noise.defaultFractalConfig{Noise.octaves = 5} Noise.openSimplex2+```++++See the [demo app](demo/) for an interactive version with adjustable parameters.+ ## Performance notes -- This library benefits considerably from compilation with the LLVM backend (`-fllvm`). Benchmarks suggest a ~50-80% difference depending on the kind of noise.+- In single-threaded scenarios with LLVM enabled, this library achieves **84-95%+ of C++ FastNoiseLite performance**.+- This library benefits considerably from compilation with the LLVM backend+ (`-fllvm`). Benchmarks suggest a ~50-80% difference depending on the kind of noise. -## Benchmarks+### Parallel noise generation -### Results+This library integrates well with [massiv](https://hackage.haskell.org/package/massiv)+for parallel computation. Parallel performance can reach 10-15x single-threaded+performance. -Measured by values / second generated by the noise functions. These results come from a benchmark with `-fllvm` enabled.+**This is the recommended approach for generating large noise textures or datasets.** -All results are for `Float`s.+### Benchmarks -There's inevitably some noise in the measurements because all of the results are forced into an unboxed vector.+#### Results -#### 2D+Measured by values / second generated by the noise functions. These results come+from a benchmark with `-fllvm` enabled. -| 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 |+There's inevitably some noise in the measurements because all of the results are+forced into an unboxed vector. -#### 3D+##### 2D -| name | values / second |-| ----------- | --------------- |-| value3 | 85_438_023 |-| perlin3 | 56_830_482 |-| valueCubic3 | 15_559_523 |+| name | Float (values/sec) | Double (values/sec) |+| ------------- | ------------------ | ------------------- |+| value2 | 173_511_654 | 189_119_731 |+| perlin2 | 154_674_464 | 161_114_532 |+| openSimplex2 | 74_747_031 | 74_332_345 |+| valueCubic2 | 61_415_544 | 62_481_313 |+| superSimplex2 | 51_295_369 | 50_383_577 |+| cellular2 | 34_996_382 | 32_652_899 | +##### 3D++| name | Float (values/sec) | Double (values/sec) |+| ----------- | ------------------ | ------------------- |+| value3 | 90_805_572 | 93_188_363 |+| perlin3 | 74_080_032 | 82_477_882 |+| valueCubic3 | 18_765_912 | 18_284_749 |+ ## 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 --++ -_Perlin_+### Perlin -+ -_Cellular_+### Cellular --++
bench/Bench.hs view
@@ -1,295 +1,501 @@ import BenchLib+import Data.Massiv.Array qualified as MA 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+import System.Random.Stateful main :: IO () main = do let sz = 1_000_000- seed = 1337 octaves = 8+ massivW = 1_000+ massivH = 1_000 defaultMain [ bgroup "2D"- ( baseline2 seed sz- <> benchPerlin2 seed octaves sz- <> benchOpenSimplex2 seed octaves sz- <> benchOpenSimplexSmooth2 seed octaves sz- <> benchValue2 seed octaves sz- <> benchValueCubic2 seed octaves sz- <> benchCombo2 seed octaves sz- <> benchCellular2 seed octaves sz+ ( baseline2 sz+ <> benchPerlin2 octaves sz+ <> benchOpenSimplex2 octaves sz+ <> benchOpenSimplexSmooth2 octaves sz+ <> benchValue2 octaves sz+ <> benchValueCubic2 octaves sz+ <> benchCombo2 octaves sz+ <> benchCellular2 octaves sz ) , bgroup "3D"- ( baseline3 seed sz- <> benchPerlin3 seed octaves sz- <> benchValue3 seed octaves sz- <> benchValueCubic3 seed octaves sz+ ( baseline3 sz+ <> benchPerlin3 octaves sz+ <> benchValue3 octaves sz+ <> benchValueCubic3 octaves sz )+ , bgroup+ "2D massiv"+ ( benchMassivBase2 massivW massivH+ <> benchMassivFractal2 octaves massivW massivH+ )+ , bgroup "FNL compare 2D" benchFnlCompare2D+ , bgroup "FNL compare 3D" benchFnlCompare3D ] -label :: (Typeable a) => String -> Int -> Seed -> Proxy a -> String-label lbl sz seed px =+label :: (Typeable a) => String -> Int -> Proxy a -> String+label lbl sz px = let lbl' = case lbl of "" -> "" v -> v <> ": "- in lbl' <> showsTypeRep (typeRep px) "" <> "[seed=" <> show seed <> "] x" <> show sz+ in lbl' <> showsTypeRep (typeRep px) "" <> " x" <> show sz -createEnv2 :: forall a. (U.Unbox a, MWC.UniformRange a, RealFrac a) => Int -> IO (U.Vector (a, a))+-- most of these functions zero at whole numbers and can short-circuit,+-- so a random offset should give a better signal of real world performance+generate2DCoords+ :: ( UniformRange a+ , RealFrac a+ , StatefulGen g IO+ )+ => g+ -> Int+ -> Int+ -> IO (a, a)+generate2DCoords g i j = do+ offsetX <- uniformRM (0.00001, 0.99999) g+ offsetY <- uniformRM (0.00001, 0.99999) g+ let r = fromIntegral i+ c = fromIntegral j++ pure (r + offsetX, c + offsetY)+{-# INLINE generate2DCoords #-}++createEnv2 :: forall a. (U.Unbox a, UniformRange a, RealFrac a) => Int -> IO (Seed, U.Vector (a, a)) createEnv2 sz = do- g <- MWC.createSystemRandom- U.generateM sz $ \i -> do- -- most of these functions zero at whole numbers and can short-circuit,- -- so a random offset should give a better signal of real world performance- offset <- MWC.uniformRM (0.00001, 0.99999) g- pure $- let r = fromIntegral $ i `div` (sz `div` 2)- c = fromIntegral $ i `mod` (sz `div` 2)- in (r + offset, c + offset)+ g <- newAtomicGenM =<< newStdGen+ seed <- uniformRM (minBound, maxBound) g+ v <- U.generateM sz $ \i ->+ generate2DCoords+ g+ (i `div` (sz `div` 2))+ (i `mod` (sz `div` 2))+ pure (seed, v) {-# INLINE createEnv2 #-} benchMany2 :: forall a- . (Typeable a, MWC.UniformRange a, U.Unbox a, RealFrac a)+ . (Typeable a, UniformRange a, U.Unbox a, RealFrac a) => String -> Int- -> Seed -> Noise2 a -> Benchmark-benchMany2 lbl sz seed f =- env (createEnv2 sz) $ \ ~v ->- bench (label lbl sz seed (Proxy @(U.Vector a))) $+benchMany2 lbl sz f =+ env (createEnv2 sz) $ \ ~(seed, v) ->+ bench (label lbl sz (Proxy @(U.Vector a))) $ nf (U.map (uncurry (noise2At f seed))) v {-# INLINE benchMany2 #-} -baseline2 :: Seed -> Int -> [Benchmark]-baseline2 seed sz =+baseline2 :: Int -> [Benchmark]+baseline2 sz = [ bgroup "baseline2"- [ benchMany2 @Float "" sz seed (const2 1)- , benchMany2 @Double "" sz seed (const2 2)+ [ benchMany2 @Float "" sz (const2 1)+ , benchMany2 @Double "" sz (const2 2) ] ]-{-# INLINE baseline2 #-} -benchPerlin2 :: Seed -> Int -> Int -> [Benchmark]-benchPerlin2 seed octaves sz =+benchPerlin2 :: Int -> Int -> [Benchmark]+benchPerlin2 octaves sz = [ bgroup "perlin2"- [ benchMany2 @Float "" sz seed perlin2- , benchMany2 @Double "" sz seed perlin2- , benchMany2 @Float "fractal" sz seed (fractal2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Double "fractal" sz seed (fractal2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Float "ridged" sz seed (ridged2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Double "ridged" sz seed (ridged2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Float "billow" sz seed (billow2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Double "billow" sz seed (billow2 defaultFractalConfig{octaves} perlin2)- , benchMany2 @Float "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength perlin2)- , benchMany2 @Double "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength perlin2)+ [ benchMany2 @Float "" sz perlin2+ , benchMany2 @Double "" sz perlin2+ , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} perlin2)+ , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength perlin2)+ , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength perlin2) ] ]-{-# INLINE benchPerlin2 #-} -benchOpenSimplex2 :: Seed -> Int -> Int -> [Benchmark]-benchOpenSimplex2 seed octaves sz =+benchOpenSimplex2 :: Int -> Int -> [Benchmark]+benchOpenSimplex2 octaves sz = [ bgroup "openSimplex2"- [ benchMany2 @Float "" sz seed openSimplex2- , benchMany2 @Double "" sz seed openSimplex2- , benchMany2 @Float "fractal" sz seed (fractal2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Double "fractal" sz seed (fractal2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Float "ridged" sz seed (ridged2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Double "ridged" sz seed (ridged2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Float "billow" sz seed (billow2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Double "billow" sz seed (billow2 defaultFractalConfig{octaves} openSimplex2)- , benchMany2 @Float "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength openSimplex2)- , benchMany2 @Double "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength openSimplex2)+ [ benchMany2 @Float "" sz openSimplex2+ , benchMany2 @Double "" sz openSimplex2+ , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} openSimplex2)+ , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength openSimplex2)+ , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength openSimplex2) ] ]-{-# INLINE benchOpenSimplex2 #-} -benchOpenSimplexSmooth2 :: Seed -> Int -> Int -> [Benchmark]-benchOpenSimplexSmooth2 seed octaves sz =+benchOpenSimplexSmooth2 :: Int -> Int -> [Benchmark]+benchOpenSimplexSmooth2 octaves sz = [ bgroup "superSimplex2"- [ benchMany2 @Float "" sz seed superSimplex2- , benchMany2 @Double "" sz seed superSimplex2- , benchMany2 @Float "fractal" sz seed (fractal2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Double "fractal" sz seed (fractal2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Float "ridged" sz seed (ridged2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Double "ridged" sz seed (ridged2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Float "billow" sz seed (billow2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Double "billow" sz seed (billow2 defaultFractalConfig{octaves} superSimplex2)- , benchMany2 @Float "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2)- , benchMany2 @Double "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2)+ [ benchMany2 @Float "" sz superSimplex2+ , benchMany2 @Double "" sz superSimplex2+ , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} superSimplex2)+ , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2)+ , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2) ] ]-{-# INLINE benchOpenSimplexSmooth2 #-} -benchValue2 :: Seed -> Int -> Int -> [Benchmark]-benchValue2 seed octaves sz =+benchValue2 :: Int -> Int -> [Benchmark]+benchValue2 octaves sz = [ bgroup "value2"- [ benchMany2 @Float "" sz seed value2- , benchMany2 @Double "" sz seed value2- , benchMany2 @Float "fractal" sz seed (fractal2 defaultFractalConfig{octaves} value2)- , benchMany2 @Double "fractal" sz seed (fractal2 defaultFractalConfig{octaves} value2)- , benchMany2 @Float "ridged" sz seed (ridged2 defaultFractalConfig{octaves} value2)- , benchMany2 @Double "ridged" sz seed (ridged2 defaultFractalConfig{octaves} value2)- , benchMany2 @Float "billow" sz seed (billow2 defaultFractalConfig{octaves} value2)- , benchMany2 @Double "billow" sz seed (billow2 defaultFractalConfig{octaves} value2)- , benchMany2 @Float "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength value2)- , benchMany2 @Double "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength value2)+ [ benchMany2 @Float "" sz value2+ , benchMany2 @Double "" sz value2+ , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} value2)+ , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength value2)+ , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength value2) ] ]-{-# INLINE benchValue2 #-} -benchValueCubic2 :: Seed -> Int -> Int -> [Benchmark]-benchValueCubic2 seed octaves sz =+benchValueCubic2 :: Int -> Int -> [Benchmark]+benchValueCubic2 octaves sz = [ bgroup "valueCubic2"- [ benchMany2 @Float "" sz seed valueCubic2- , benchMany2 @Double "" sz seed valueCubic2- , benchMany2 @Float "fractal" sz seed (fractal2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Double "fractal" sz seed (fractal2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Float "ridged" sz seed (ridged2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Double "ridged" sz seed (ridged2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Float "billow" sz seed (billow2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Double "billow" sz seed (billow2 defaultFractalConfig{octaves} valueCubic2)- , benchMany2 @Float "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic2)- , benchMany2 @Double "pingPong" sz seed (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic2)+ [ benchMany2 @Float "" sz valueCubic2+ , benchMany2 @Double "" sz valueCubic2+ , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} valueCubic2)+ , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic2)+ , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic2) ] ]-{-# INLINE benchValueCubic2 #-} -benchCombo2 :: Seed -> Int -> Int -> [Benchmark]-benchCombo2 seed octaves sz =+benchCombo2 :: Int -> Int -> [Benchmark]+benchCombo2 octaves sz = [ bgroup "numeric combination"- [ benchMany2 @Float "perlin * opensimplex/2" sz seed $+ [ benchMany2 @Float "perlin * opensimplex/2" sz $ openSimplex2 / 2 * perlin2- , benchMany2 @Float "(4 * perlin) / 4" sz seed $+ , benchMany2 @Float "(4 * perlin) / 4" sz $ 4 * perlin2 / 4- , benchMany2 @Float "(perlin + perlin + perlin + perlin) / 4" sz seed $+ , benchMany2 @Float "(perlin + perlin + perlin + perlin) / 4" sz $ (perlin2 + perlin2 + perlin2 + perlin2) / 4- , benchMany2 @Float "fractal (perlin * opensimplex/2)" sz seed $+ , benchMany2 @Float "fractal (perlin * opensimplex/2)" sz $ fractal2 defaultFractalConfig{octaves} (openSimplex2 / 2 * perlin2)- , benchMany2 @Float "fractal perlin * fractal opensimplex" sz seed $+ , benchMany2 @Float "fractal perlin * fractal opensimplex" sz $ fractal2 defaultFractalConfig{octaves} perlin2 * fractal2 defaultFractalConfig{octaves} openSimplex2 ] ]-{-# INLINE benchCombo2 #-} -benchCellular2 :: Seed -> Int -> Int -> [Benchmark]-benchCellular2 seed _ sz =+benchCellular2 :: Int -> Int -> [Benchmark]+benchCellular2 _ sz = [ bgroup "cellular2"- ( benches @Float Proxy- <> benches @Double Proxy- )+ [ benchMany2 @Float+ "DistEuclidean CellValue"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = CellValue})+ , benchMany2 @Float+ "DistEuclidean Distance2Add"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = Distance2Add})+ , benchMany2 @Float+ "DistManhattan CellValue"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistManhattan, cellularResult = CellValue})+ , benchMany2 @Float+ "DistManhattan Distance2Add"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistManhattan, cellularResult = Distance2Add})+ , benchMany2 @Double+ "DistEuclidean CellValue"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = CellValue})+ , benchMany2 @Double+ "DistEuclidean Distance2Add"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = Distance2Add})+ , benchMany2 @Double+ "DistManhattan CellValue"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistManhattan, cellularResult = CellValue})+ , benchMany2 @Double+ "DistManhattan Distance2Add"+ sz+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistManhattan, cellularResult = Distance2Add})+ ] ]- where- benches- :: forall a. (Typeable a, MWC.UniformRange a, U.Unbox a, RealFrac a, Floating a) => Proxy a -> [Benchmark]- benches _ =- [ benchMany2 @a (show d <> " " <> show r) sz seed (cellular2 config)- | d <- [DistEuclidean]- , r <- [CellValue, Distance2Add]- , let config = defaultCellularConfig{cellularDistanceFn = d, cellularResult = r}- ]- {-# INLINE benches #-}-{-# INLINE benchCellular2 #-} -createEnv3 :: forall a m. (Monad m, U.Unbox a, Num a) => Int -> m (U.Vector (a, a, a))+-- | Create environment for FNL-style 2D benchmarks with integer-aligned coordinates+-- Mimics FastNoiseLite's benchmark methodology exactly:+-- for(y = 0; y < gridSize; y++)+-- for(x = 0; x < gridSize; x++)+-- noise(float(x), float(y))+createEnvFnl2 :: Int -> IO (Seed, U.Vector (Float, Float))+createEnvFnl2 gridSize = do+ g <- newAtomicGenM =<< newStdGen+ seed <- uniformRM (minBound, maxBound) g+ let v = U.generate (gridSize * gridSize) $ \i ->+ let x = fromIntegral (i `mod` gridSize) :: Float+ y = fromIntegral (i `div` gridSize) :: Float+ in (x, y)+ pure (seed, v)+{-# INLINE createEnvFnl2 #-}++-- | Benchmark for FNL comparison (integer coordinates, Float only)+-- Uses foldl' to avoid vector materialization overhead, matching FNL's DoNotOptimize approach+-- Sums results to prevent DCE while keeping overhead minimal+benchFnlCompare2+ :: String+ -> Int+ -> Noise2 Float+ -> Benchmark+benchFnlCompare2 lbl gridSize f =+ env (createEnvFnl2 gridSize) $ \ ~(seed, v) ->+ bench (lbl <> ": Float (FNL grid) x" <> show (gridSize * gridSize)) $+ nf (\vec -> U.foldl' (\acc (x, y) -> acc + (noise2At f seed) x y) 0 vec) v+{-# INLINE benchFnlCompare2 #-}++-- | FNL-style 2D benchmarks: 512x512 grid with integer coordinates+benchFnlCompare2D :: [Benchmark]+benchFnlCompare2D =+ let gridSize = 512+ in [ bgroup+ "FNL compare"+ [ benchFnlCompare2 "value2" gridSize value2+ , benchFnlCompare2 "perlin2" gridSize perlin2+ , benchFnlCompare2 "openSimplex2" gridSize openSimplex2+ , benchFnlCompare2 "superSimplex2" gridSize superSimplex2+ , benchFnlCompare2 "valueCubic2" gridSize valueCubic2+ , benchFnlCompare2+ "cellular2 (Distance)"+ gridSize+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = Distance})+ ]+ ]++createEnv3 :: (U.Unbox a, UniformRange a, RealFrac a) => Int -> IO (Seed, U.Vector (a, a, a)) createEnv3 sz = do- !ixs <- U.generateM sz $ \i ->- pure $- let d = sz `div` 3- !x = fromIntegral $ i `div` d `mod` d- !y = fromIntegral $ i `div` (d * d)- !z = fromIntegral $ i `div` d- in (x, y, z)- pure ixs+ g <- newAtomicGenM =<< newStdGen+ seed <- uniformRM (minBound, maxBound) g+ offsetX <- uniformRM (0.00001, 0.99999) g+ offsetY <- uniformRM (0.00001, 0.99999) g+ offsetZ <- uniformRM (0.00001, 0.99999) g+ !ixs <- U.generateM sz $ \i -> do+ let d = sz `div` 3+ !x = fromIntegral $ i `div` d `mod` d+ !y = fromIntegral $ i `div` (d * d)+ !z = fromIntegral $ i `div` d+ pure (x + offsetX, y + offsetY, z + offsetZ)+ pure (seed, ixs) {-# INLINE createEnv3 #-} benchMany3 :: forall a- . (Typeable a, RealFrac a, U.Unbox a)+ . (Typeable a, UniformRange a, RealFrac a, U.Unbox a) => String -> Int- -> Seed -> Noise3 a -> Benchmark-benchMany3 lbl sz seed f =- env (createEnv3 sz) $ \ ~v ->- bench (label lbl sz seed (Proxy @(U.Vector a))) $+benchMany3 lbl sz f =+ env (createEnv3 sz) $ \ ~(seed, v) ->+ bench (label lbl sz (Proxy @(U.Vector a))) $ nf (U.map (\(x, y, z) -> noise3At f seed x y z)) v {-# INLINE benchMany3 #-} -baseline3 :: Seed -> Int -> [Benchmark]-baseline3 seed sz =+baseline3 :: Int -> [Benchmark]+baseline3 sz = [ bgroup "baseline3"- [ benchMany3 @Float "" sz seed (const3 1)- , benchMany3 @Double "" sz seed (const3 2)+ [ benchMany3 @Float "" sz (const3 1)+ , benchMany3 @Double "" sz (const3 2) ] ]-{-# INLINE baseline3 #-} -benchPerlin3 :: Seed -> Int -> Int -> [Benchmark]-benchPerlin3 seed octaves sz =+benchPerlin3 :: Int -> Int -> [Benchmark]+benchPerlin3 octaves sz = [ bgroup "perlin3"- [ benchMany3 @Float "" sz seed perlin3- , benchMany3 @Double "" sz seed perlin3- , benchMany3 @Float "fractal" sz seed (fractal3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Double "fractal" sz seed (fractal3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Float "ridged" sz seed (ridged3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Double "ridged" sz seed (ridged3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Float "billow" sz seed (billow3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Double "billow" sz seed (billow3 defaultFractalConfig{octaves} perlin3)- , benchMany3 @Float "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength perlin3)- , benchMany3 @Double "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength perlin3)+ [ benchMany3 @Float "" sz perlin3+ , benchMany3 @Double "" sz perlin3+ , benchMany3 @Float "fractal" sz (fractal3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Double "fractal" sz (fractal3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Float "ridged" sz (ridged3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Double "ridged" sz (ridged3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Float "billow" sz (billow3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Double "billow" sz (billow3 defaultFractalConfig{octaves} perlin3)+ , benchMany3 @Float "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength perlin3)+ , benchMany3 @Double "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength perlin3) ] ]-{-# INLINE benchPerlin3 #-} -benchValue3 :: Seed -> Int -> Int -> [Benchmark]-benchValue3 seed octaves sz =+benchValue3 :: Int -> Int -> [Benchmark]+benchValue3 octaves sz = [ bgroup "value3"- [ benchMany3 @Float "" sz seed value3- , benchMany3 @Double "" sz seed value3- , benchMany3 @Float "fractal" sz seed (fractal3 defaultFractalConfig{octaves} value3)- , benchMany3 @Double "fractal" sz seed (fractal3 defaultFractalConfig{octaves} value3)- , benchMany3 @Float "ridged" sz seed (ridged3 defaultFractalConfig{octaves} value3)- , benchMany3 @Double "ridged" sz seed (ridged3 defaultFractalConfig{octaves} value3)- , benchMany3 @Float "billow" sz seed (billow3 defaultFractalConfig{octaves} value3)- , benchMany3 @Double "billow" sz seed (billow3 defaultFractalConfig{octaves} value3)- , benchMany3 @Float "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength value3)- , benchMany3 @Double "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength value3)+ [ benchMany3 @Float "" sz value3+ , benchMany3 @Double "" sz value3+ , benchMany3 @Float "fractal" sz (fractal3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Double "fractal" sz (fractal3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Float "ridged" sz (ridged3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Double "ridged" sz (ridged3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Float "billow" sz (billow3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Double "billow" sz (billow3 defaultFractalConfig{octaves} value3)+ , benchMany3 @Float "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength value3)+ , benchMany3 @Double "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength value3) ] ]-{-# INLINE benchValue3 #-} -benchValueCubic3 :: Seed -> Int -> Int -> [Benchmark]-benchValueCubic3 seed octaves sz =+benchValueCubic3 :: Int -> Int -> [Benchmark]+benchValueCubic3 octaves sz = [ bgroup "valueCubic3"- [ benchMany3 @Float "" sz seed valueCubic3- , benchMany3 @Double "" sz seed valueCubic3- , benchMany3 @Float "fractal" sz seed (fractal3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Double "fractal" sz seed (fractal3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Float "ridged" sz seed (ridged3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Double "ridged" sz seed (ridged3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Float "billow" sz seed (billow3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Double "billow" sz seed (billow3 defaultFractalConfig{octaves} valueCubic3)- , benchMany3 @Float "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic3)- , benchMany3 @Double "pingPong" sz seed (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic3)+ [ benchMany3 @Float "" sz valueCubic3+ , benchMany3 @Double "" sz valueCubic3+ , benchMany3 @Float "fractal" sz (fractal3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Double "fractal" sz (fractal3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Float "ridged" sz (ridged3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Double "ridged" sz (ridged3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Float "billow" sz (billow3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Double "billow" sz (billow3 defaultFractalConfig{octaves} valueCubic3)+ , benchMany3 @Float "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic3)+ , benchMany3 @Double "pingPong" sz (pingPong3 defaultFractalConfig{octaves} defaultPingPongStrength valueCubic3) ] ]-{-# INLINE benchValueCubic3 #-}++-- | Create environment for FNL-style 3D benchmarks with integer-aligned coordinates+-- Mimics FastNoiseLite's benchmark methodology exactly:+-- for(z = 0; z < gridSize; z++)+-- for(y = 0; y < gridSize; y++)+-- for(x = 0; x < gridSize; x++)+-- noise(float(x), float(y), float(z))+createEnvFnl3 :: Int -> IO (Seed, U.Vector (Float, Float, Float))+createEnvFnl3 gridSize = do+ g <- newAtomicGenM =<< newStdGen+ seed <- uniformRM (minBound, maxBound) g+ let gridSq = gridSize * gridSize+ v = U.generate (gridSize * gridSize * gridSize) $ \i ->+ let x = fromIntegral (i `mod` gridSize) :: Float+ y = fromIntegral ((i `div` gridSize) `mod` gridSize) :: Float+ z = fromIntegral (i `div` gridSq) :: Float+ in (x, y, z)+ pure (seed, v)+{-# INLINE createEnvFnl3 #-}++-- | Benchmark for FNL 3D comparison (integer coordinates, Float only)+-- Uses foldl' to avoid vector materialization overhead, matching FNL's DoNotOptimize approach+-- Sums results to prevent DCE while keeping overhead minimal+benchFnlCompare3+ :: String+ -> Int+ -> Noise3 Float+ -> Benchmark+benchFnlCompare3 lbl gridSize f =+ env (createEnvFnl3 gridSize) $ \ ~(seed, v) ->+ bench (lbl <> ": Float (FNL grid) x" <> show (gridSize * gridSize * gridSize)) $+ nf (\vec -> U.foldl' (\acc (x, y, z) -> acc + noise3At f seed x y z) 0 vec) v+{-# INLINE benchFnlCompare3 #-}++-- | FNL-style 3D benchmarks: 64x64x64 grid with integer coordinates+benchFnlCompare3D :: [Benchmark]+benchFnlCompare3D =+ let gridSize = 64+ in [ bgroup+ "FNL compare"+ [ benchFnlCompare3 "value3" gridSize value3+ , benchFnlCompare3 "perlin3" gridSize perlin3+ , benchFnlCompare3 "valueCubic3" gridSize valueCubic3+ ]+ ]++benchMassiv2+ :: forall a+ . (Typeable a, U.Unbox a, RealFrac a, UniformRange a)+ => String+ -> Int+ -> Int+ -> Noise2 a+ -> Benchmark+benchMassiv2 lbl !w !h noiseF =+ env+ ( do+ g <- newAtomicGenM =<< newStdGen+ seed <- uniformRM (minBound, maxBound) g+ -- This intentionally breaks the optimizer's ability to DCE. If we try to calculate+ -- inline it seems that GHC is smart enough to figure out that the whole-number+ -- integral points involve relatively simple code paths.+ (arr :: MA.Array MA.U MA.Ix2 (a, a)) <-+ MA.generateArray @MA.U MA.Par (MA.Sz2 h w) $ \(i MA.:. j) ->+ generate2DCoords g i j++ pure (seed, arr)+ )+ $ \ ~(seed, arr) ->+ bench (label lbl (w * h) (Proxy @a)) $+ nf+ ( MA.computeP @MA.U+ . MA.map+ ( \(!x, !y) ->+ noise2At noiseF seed x y+ )+ )+ arr+{-# INLINE benchMassiv2 #-}++benchMassivBase2 :: Int -> Int -> [Benchmark]+benchMassivBase2 !w !h =+ [ bgroup+ "massiv base2"+ [ benchMassiv2 @Float "perlin2" w h perlin2+ , benchMassiv2 @Double "perlin2" w h perlin2+ , benchMassiv2 @Float "openSimplex2" w h openSimplex2+ , benchMassiv2 @Double "openSimplex2" w h openSimplex2+ , benchMassiv2 @Float "superSimplex2" w h superSimplex2+ , benchMassiv2 @Double "superSimplex2" w h superSimplex2+ , benchMassiv2 @Float "value2" w h value2+ , benchMassiv2 @Double "value2" w h value2+ , benchMassiv2 @Float "valueCubic2" w h valueCubic2+ , benchMassiv2 @Double "valueCubic2" w h valueCubic2+ , benchMassiv2 @Float+ "cellular2"+ w+ h+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = CellValue})+ , benchMassiv2 @Double+ "cellular2"+ w+ h+ (cellular2 defaultCellularConfig{cellularDistanceFn = DistEuclidean, cellularResult = CellValue})+ ]+ ]++benchMassivFractal2 :: Int -> Int -> Int -> [Benchmark]+benchMassivFractal2 octaves w h =+ [ bgroup+ "massiv fractal2"+ [ benchMassiv2 @Float "perlin2 fractal" w h (fractal2 defaultFractalConfig{octaves} perlin2)+ , benchMassiv2 @Double "perlin2 fractal" w h (fractal2 defaultFractalConfig{octaves} perlin2)+ , benchMassiv2 @Float "value2 fractal" w h (fractal2 defaultFractalConfig{octaves} value2)+ , benchMassiv2 @Double "value2 fractal" w h (fractal2 defaultFractalConfig{octaves} value2)+ , benchMassiv2 @Float "openSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} openSimplex2)+ , benchMassiv2 @Double "openSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} openSimplex2)+ , benchMassiv2 @Float "superSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} superSimplex2)+ , benchMassiv2 @Double "superSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} superSimplex2)+ ]+ ]
bench/BenchLib.hs view
pure-noise.cabal view
@@ -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 <https://github.com/jtnuttall/pure-noise#readme>+version: 0.2.1.1+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@@ -17,8 +21,13 @@ license: BSD-3-Clause license-file: LICENSE build-type: Simple+tested-with:+ GHC == 9.6.7+ , GHC == 9.8.4+ , GHC == 9.10.2 extra-source-files: README.md+extra-doc-files: CHANGELOG.md source-repository head@@ -30,14 +39,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,17 +54,24 @@ 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 type: exitcode-stdio-1.0 main-is: Driver.hs other-modules:+ CellularSpec+ FractalSpec+ Golden.Util Noise2Spec Noise3Spec+ OpenSimplexSpec PerlinSpec+ SuperSimplexSpec+ ValueCubicSpec+ ValueSpec Paths_pure_noise autogen-modules: Paths_pure_noise@@ -63,13 +79,23 @@ 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+ JuicyPixels ==3.3.*+ , aeson >=2.0 && <2.3+ , aeson-pretty+ , base >=4.16 && <5+ , bytestring+ , directory+ , filepath+ , massiv >=1.0 && <2.0+ , primitive >=0.8 && <0.10 , pure-noise , tasty , tasty-discover+ , tasty-golden , tasty-hunit , tasty-quickcheck- , vector <=0.14+ , text+ , typed-process default-language: GHC2021 benchmark pure-noise-bench@@ -82,12 +108,14 @@ 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+ , massiv >=1.0 && <2.0+ , primitive >=0.8 && <0.10 , pure-noise+ , random , tasty , tasty-bench , vector <=0.14
src/Numeric/Noise.hs view
@@ -1,112 +1,242 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE Strict #-} -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability : experimental+--+-- Performant noise generation with composable noise functions.+--+-- Noise functions are built on a unified 'Noise' type that abstracts over+-- the seed and coordinate parameters. 'Noise2' and 'Noise3' are convenient+-- type aliases for 2D and 3D noise. These can be composed algebraically+-- 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+-- @+--+-- == Advanced Features+--+-- Generate 1D noise by slicing higher-dimensional noise:+--+-- @+-- noise1d :: Noise.Noise1 Float+-- noise1d = Noise.sliceY2 0.5 Noise.perlin2+--+-- evaluate :: Float -> Float+-- evaluate = Noise.noise1At noise1d 0+-- @+--+-- Transform coordinates with 'warp':+--+-- @+-- scaledAndLayered :: Noise.Noise2 Float+-- scaledAndLayered =+-- Noise.warp (\\(x, y) -> (x * 2, y * 2)) Noise.perlin2+-- + fmap (logBase 2) Noise.perlin2+-- @+--+-- Layer independent noise with 'reseed' or 'next2':+--+-- @+-- layered :: Noise.Noise2 Float+-- layered = Noise.perlin2 + Noise.next2 Noise.perlin2 \/ 2+-- @ module Numeric.Noise (- -- * Noise functions+ -- * Noise - -- ** Noise functions- module NoiseTypes,+ --++ -- | 'Noise1', 'Noise2', and 'Noise3' are type aliases for 1D, 2D, and 3D noise+ -- functions built on the unified 'Noise' type. They can be evaluated with+ -- 'noise1At', 'noise2At', and 'noise3At' respectively.+ --+ -- 'Seed' is a 'Data.Word.Word64' value used for deterministic noise generation.+ Noise,+ Noise1,+ Noise1',+ Noise2,+ Noise2',+ Noise3,+ Noise3',+ Seed,++ -- * Accessors+ noise1At, noise2At, noise3At, - -- ** 2D Noise- cellular2,+ -- * Noise functions++ -- ** Perlin+ perlin2,+ perlin3,++ -- ** OpenSimplex openSimplex2,++ -- ** OpenSimplex2S superSimplex2,- perlin2,++ -- ** Cellular+ cellular2,++ -- *** Configuration+ CellularConfig (..),+ defaultCellularConfig,+ CellularDistanceFn (..),+ CellularResult (..),++ -- ** Value value2, valueCubic2,-- -- ** 3D Noise- perlin3, value3, valueCubic3, - -- * Noise manipulation+ -- ** Constant fields+ const2,+ const3, - -- ** Math utility functions- module NoiseUtility,+ -- * Noise alteration - -- ** Fractal Brownian Motion- module Fractal,+ -- ** Altering values+ remap,+ -- ** Altering parameters+ warp,+ reseed,+ next2,+ next3, - -- ** Cellular noise configuration- module Cellular,-) where+ -- ** Slicing (projecting)+ sliceX2,+ sliceX3,+ sliceY2,+ sliceY3,+ sliceZ3, -import Numeric.Noise.Cellular as Cellular (- CellularConfig (..),- CellularDistanceFn (..),- CellularResult (..),- defaultCellularConfig,- )-import Numeric.Noise.Cellular qualified as Cellular-import Numeric.Noise.Fractal as Fractal-import Numeric.Noise.Internal-import Numeric.Noise.Internal as NoiseTypes (- Noise2,- Noise3,- Seed,- )-import Numeric.Noise.Internal as NoiseUtility (+ -- * Fractals++ --++ -- | 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".++ -- ** Fractal Brownian Motion (FBM)+ fractal2,+ fractal3,++ -- ** Fractal variants+ billow2,+ billow3,+ ridged2,+ ridged3,+ pingPong2,+ pingPong3,++ -- ** Configuration+ FractalConfig (..),+ defaultFractalConfig,+ PingPongStrength (..),+ defaultPingPongStrength,++ -- * Math utilities clamp, clamp2, clamp3, cubicInterp, hermiteInterp, lerp,- next2,- next3, quinticInterp,- )+) where++import Numeric.Noise.Cellular (CellularConfig, CellularDistanceFn (..), CellularResult (..), defaultCellularConfig)+import Numeric.Noise.Cellular qualified as Cellular+import Numeric.Noise.Fractal+import Numeric.Noise.Internal import Numeric.Noise.OpenSimplex qualified as OpenSimplex import Numeric.Noise.Perlin qualified as Perlin import Numeric.Noise.SuperSimplex qualified as SuperSimplex import Numeric.Noise.Value qualified as Value import Numeric.Noise.ValueCubic qualified as ValueCubic -noise2At :: Noise2 a -> Seed -> a -> a -> a-noise2At = unNoise2-{-# INLINE noise2At #-}-+-- | 2D Cellular (Worley) noise. Configure with 'CellularConfig' to control+-- distance functions and return values.+--+-- Cellular noise creates patterns based on distances to randomly distributed+-- cell points. 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-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 #-}
src/Numeric/Noise/Cellular.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-} -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>@@ -14,23 +15,32 @@ -- * 2D Noise noise2,- noise2BaseWith, ) where import Data.Bits-import Data.Foldable-import Data.Vector.Unboxed qualified as U+import Data.Foldable (foldl') -- 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- , cellularJitter :: !a- , cellularResult :: !CellularResult+ { 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] \) 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@@ -38,22 +48,49 @@ , cellularJitter = 1 , cellularResult = CellValue }+{-# INLINEABLE defaultCellularConfig #-} +-- | Distance function for cellular noise calculations.+--+-- Different distance metrics produce different visual characteristics+-- in the cellular pattern. data CellularDistanceFn- = DistEuclidean- | DistEuclideanSq- | DistManhattan- | DistHybrid+ = -- | \( \sqrt{dx^2 + dy^2} \) - Creates circular cells with smooth edges.+ DistEuclidean+ | -- | \( dx^2 + dy^2 \) - Faster than 'DistEuclidean' with similar appearance.+ DistEuclideanSq+ | -- | \( |dx| + |dy| \) - Creates diamond-shaped cells with sharp edges.+ DistManhattan+ | -- | Hybrid of Euclidean and Manhattan distances.+ 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,69 +108,95 @@ {-# INLINE normDist #-} noise2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a-noise2 CellularConfig{..} =+noise2 CellularConfig{..} = mkNoise2 $ \ !seed !x !y -> let !jitter = cellularJitter * 0.43701595- !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 #-}+ !rx = round x+ !ry = round y --- | 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+ dist = distance cellularDistanceFn+ norm = normDist cellularDistanceFn+ coeff = 1 / (maxHash + 1) - minmax (!c, !d0, !d1) (!h, !d)- | d < d0 = (h, d, d1')- | otherwise = (c, d0, d1')- where- !d1' = max (min d1 d) d0+ {-# 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 = lookupRandVec2d i+ !rvy = lookupRandVec2d (i .|. 1)+ !d = dist (px + rvx * jitter) (py + rvy * jitter)+ in (h, d) - 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 points #-}+ points = [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]] --- >>> U.length randVecs2d == 512+ {-# INLINE selectMinHash #-}+ selectMinHash =+ let minHash (!hMin, !dMin) (!h, !d)+ | d < dMin = (h, d)+ | otherwise = (hMin, dMin)+ in foldl' minHash (0, infinity) points++ {-# 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+{-# INLINE [2] noise2 #-}++lookupRandVec2d :: (RealFrac a) => Hash -> a+lookupRandVec2d = realToFrac . indexPrimArray randVecs2dd . fromIntegral+{-# NOINLINE [1] lookupRandVec2d #-}++{-# RULES+"lookupRandVec2d/Float" forall h.+ lookupRandVec2d h =+ indexPrimArray randVecs2df (fromIntegral h)+"lookupRandVec2d/Double" forall h.+ lookupRandVec2d h =+ indexPrimArray randVecs2dd (fromIntegral h)+ #-}++randVecs2df :: PrimArray Float+randVecs2df = mapPrimArray realToFrac randVecs2dd++-- >>> sizeofPrimArray randVecs2d == 512 -- True {- ORMOLU_DISABLE -}-randVecs2d :: U.Vector Float-randVecs2d =+randVecs2dd :: PrimArray Double+randVecs2dd = [-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 ,-0.8497875957,-0.5271252623,-0.879042592,0.4767432447,-0.892300288,-0.4514423508,-0.379844434,-0.9250503802
src/Numeric/Noise/Fractal.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-} -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>@@ -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@@ -53,23 +69,64 @@ , gain = 0.5 , weightedStrength = 0 }+{-# INLINEABLE defaultFractalConfig #-} +-- | 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 #-}+fractal2 config = mkNoise2 . fractal2With fractalNoiseMod (fractalAmpMod config) config . noise2At+{-# INLINE [2] 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 #-}+billow2 config = mkNoise2 . fractal2With billowNoiseMod (billowAmpMod config) config . noise2At+{-# INLINE [2] 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 #-}+ridged2 config = mkNoise2 . fractal2With ridgedNoiseMod (ridgedAmpMod config) config . noise2At+{-# INLINE [2] 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-{-# INLINE pingPong2 #-}+ mkNoise2 . fractal2With (pingPongNoiseMod strength) (pingPongAmpMod config) config . noise2At+{-# INLINE [2] pingPong2 #-} fractal2With :: (RealFrac a)@@ -84,34 +141,46 @@ -> a -> a fractal2With modNoise modAmps FractalConfig{..} noise2 seed x y- | octaves < 1 = error "octaves must be a positive integer"+ | octaves < 1 = 0 | otherwise =- let bounding = fractalBounding FractalConfig{..}+ let !bounding = fractalBounding FractalConfig{..} in go octaves 0 seed 1 bounding where- go 0 acc _ _ _ = acc- go o acc s freq amp =- let noise = amp * modNoise (noise2 s (freq * x) (freq * y))- amp' = amp * gain * modAmps (min (noise + 1) 2)+ go 0 !acc !_ !_ !_ = acc+ go !o !acc !s !freq !amp =+ let !noise = amp * modNoise (noise2 s (freq * x) (freq * y))+ !amp' = amp * gain * modAmps (min (noise + 1) 2) in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp'-{-# INLINE fractal2With #-}+{-# INLINE [1] 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 #-}+fractal3 config = mkNoise3 . fractal3With fractalNoiseMod (fractalAmpMod config) config . noise3At+{-# INLINE [2] 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 #-}+billow3 config = mkNoise3 . fractal3With billowNoiseMod (billowAmpMod config) config . noise3At+{-# INLINE [2] 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 #-}+ridged3 config = mkNoise3 . fractal3With ridgedNoiseMod (ridgedAmpMod config) config . noise3At+{-# INLINE [2] 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-{-# INLINE pingPong3 #-}+ mkNoise3 . fractal3With (pingPongNoiseMod strength) (pingPongAmpMod config) config . noise3At+{-# INLINE [2] pingPong3 #-} fractal3With :: (RealFrac a)@@ -127,61 +196,98 @@ -> a -> a fractal3With modNoise modAmps FractalConfig{..} noise3 seed x y z- | octaves < 1 = error "octaves must be a positive integer"+ | octaves < 1 = 0 | otherwise =- let bounding = fractalBounding FractalConfig{..}+ let !bounding = fractalBounding FractalConfig{..} in go octaves 0 seed 1 bounding where- go 0 acc _ _ _ = acc- go o acc s freq amp =- let noise = amp * modNoise (noise3 s (freq * x) (freq * y) (freq * z))- amp' = amp * gain * modAmps (min (noise + 1) 2)+ go 0 !acc !_ !_ !_ = acc+ go !o !acc !s !freq !amp =+ let !noise = amp * modNoise (noise3 s (freq * x) (freq * y) (freq * z))+ !amp' = amp * gain * modAmps (min (noise + 1) 2) in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp'-{-# INLINE fractal3With #-}+{-# INLINE [1] fractal3With #-} fractalBounding :: (RealFrac a) => FractalConfig a -> a-fractalBounding FractalConfig{..} =- let amps = take octaves $ iterate (* gain) gain- in 1 / (sum amps + 1)-{-# INLINE fractalBounding #-}+fractalBounding FractalConfig{..} = recip (sum amps + 1)+ where+ amps = take octaves $ iterate (* gain) gain+{-# INLINE [2] 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 t = n' - fromIntegral @Int (truncate (n' * 0.5) * 2)- in if t < 1 then t else 2 - t+ in 1 - abs (t - 1) {-# 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 #-}
src/Numeric/Noise/Internal.hs view
@@ -3,14 +3,33 @@ -- Stability : experimental module Numeric.Noise.Internal ( module Math,- Noise2 (..),+ Noise (..),+ constant,+ remap,+ warp,+ reseed,+ blend,+ sliceX2,+ sliceY2,+ sliceX3,+ sliceY3,+ sliceZ3,+ Noise1',+ Noise1,+ mkNoise1,+ noise1At,+ Noise2',+ Noise2,+ mkNoise2,+ noise2At, next2,- map2, clamp2, const2,- Noise3 (..),+ Noise3',+ Noise3,+ mkNoise3,+ noise3At, next3,- map3, clamp3, const3, ) where@@ -25,138 +44,340 @@ quinticInterp, ) -newtype Noise2 a = Noise2- {unNoise2 :: Seed -> a -> a -> a}+-- | 'Noise' represents a function from a 'Seed' and coordinates @p@ to a noise+-- value @v@.+--+-- For convenience, dimension-specific type aliases are provided:+--+-- Use 'warp' to transform coordinates and 'remap' (or 'fmap') to transform values.+--+-- To evaluate noise functions, use 'noise1At', 'noise2At', or 'noise3At'+--+-- NB: 'Noise' is a lawful 'Profunctor' where 'lmap' = warp and 'rmap' = remap.+-- There are some useful implications to this, but pure-noise is committed to+-- a minimal dependency footprint and so will not provide this instance itself.+--+-- === __Algebraic composition__+--+-- 'Noise' can be composed algebraically:+--+-- @+-- combined :: Noise (Float, Float) Float+-- combined = (perlin2 + superSimplex2) / 2+-- @+--+-- === __Coordinate Transformation__+--+-- This allows you to, for example, compose multiple layers of noise at different+-- offsets.+--+-- @+-- scaled :: Noise2 Float+-- scaled = warp (\\(x, y) -> (x * 2, y * 2)) perlin2+-- @+newtype Noise p v = Noise {unNoise :: Seed -> p -> v} +-- NOTE: Noise p v is isomorphic to Reader (Seed, p), so it has trivial+-- instances of Monad and Category, Arrow, ArrowChoice, ArrowApply, etc.+--+-- I've decided not to include Category et al. as instances for now+-- because I can't come up with a use-case that is not sufficiently+-- covered by the monad instance.++-- | Noise admits 'Functor' on the value it produces+instance Functor (Noise p) where+ fmap f (Noise g) = Noise (\seed -> f . g seed)++-- | Noise admits 'Applicative' on the value it produces+instance Applicative (Noise p) where+ pure a = Noise $ \_ _ -> a+ liftA2 f (Noise g) (Noise h) = Noise (\s p -> g s p `f` h s p)++-- | Note: The 'Monad' instance evaluates all noise functions at the same+-- seed and coordinate. For independent sampling at different coordinates,+-- use 'warp' to transform the coordinate space.+--+-- @+-- do n1 <- perlin2+-- n2 <- superSimplex2+-- return (n1 + n2)+-- @+--+-- is equivalent to:+--+-- @+-- perlin2 + superSimplex2+-- @+--+-- This is useful for domain warping.+instance Monad (Noise p) where+ Noise g >>= f = Noise (\s p -> unNoise (f (g s p)) s p)++instance (Num a) => Num (Noise p a) where+ (+) = liftA2 (+)+ (*) = liftA2 (*)+ abs = fmap abs+ signum = fmap signum+ fromInteger i = pure (fromInteger i)+ negate = fmap negate++instance (Fractional a) => Fractional (Noise p a) where+ fromRational = pure . fromRational+ recip = fmap recip+ (/) = liftA2 (/)++instance (Floating a) => Floating (Noise p a) where+ pi = pure pi+ exp = fmap exp+ log = fmap log+ sin = fmap sin+ cos = fmap cos+ asin = fmap asin+ acos = fmap acos+ atan = fmap atan+ sinh = fmap sinh+ cosh = fmap cosh+ asinh = fmap asinh+ acosh = fmap acosh+ atanh = fmap atanh++type Noise1' p v = Noise p v+type Noise1 v = Noise1' v v++mkNoise1 :: (Seed -> p -> v) -> Noise1' p v+mkNoise1 = Noise+{-# INLINE mkNoise1 #-}++-- | Evaluate a 1D noise function at the given coordinates with the given seed.+-- Currently, you must use a slicing function like 'sliceX' to reduce+-- higher-dimensional noise into 1D noise.+noise1At :: Noise1 a -> Seed -> a -> a+noise1At = unNoise+{-# INLINE noise1At #-}++type Noise2' p v = Noise (p, p) v+type Noise2 v = Noise2' v v++mkNoise2 :: (Seed -> p -> p -> v) -> Noise2' p v+mkNoise2 f = Noise (\s (x, y) -> f s x y)+{-# INLINE mkNoise2 #-}++-- | 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 (Noise f) seed x y = f seed (x, y)+{-# INLINE noise2At #-}++type Noise3' p v = Noise (p, p, p) v+type Noise3 v = Noise3' v v++mkNoise3 :: (Seed -> p -> p -> p -> v) -> Noise3' p v+mkNoise3 f = Noise (\s (x, y, z) -> f s x y z)+{-# INLINE mkNoise3 #-}++-- | 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 (Noise f) seed x y z = f seed (x, y, z)+{-# INLINE noise3At #-}++-- | Transform the values produced by a noise function.+--+-- This is an alias for 'fmap'. Use it to transform noise values after generation:+--+-- === __Examples__+--+-- @+-- -- Scale noise from [-1, 1] to [0, 1]+-- normalized :: Noise2 Float+-- normalized = remap (\\x -> (x + 1) / 2) perlin2+-- @+remap :: (a -> b) -> Noise p a -> Noise p b+remap = fmap+{-# INLINE remap #-}++-- | Transform the coordinate space of a noise function.+--+-- This allows you to scale, rotate, or otherwise modify coordinates before+-- they're passed to the noise function:+--+-- NB: This is 'contramap'+--+-- === __Examples__+--+-- @+-- -- Scale the noise frequency+-- scaled :: Noise2 Float+-- scaled = warp (\\(x, y) -> (x * 2, y * 2)) perlin2+--+-- -- Rotate the noise field+-- rotated :: Noise2 Float+-- rotated = warp (\\(x, y) -> (x * cos a - y * sin a, x * sin a + y * cos a)) perlin2+-- where a = pi / 4+-- @+warp :: (p -> p') -> Noise p' v -> Noise p v+warp f (Noise g) = Noise (\s p -> g s (f p))+{-# INLINE warp #-}++-- | Modify the seed used by a noise function.+--+-- This is useful for generating independent layers of noise:+--+-- See also 'next2' and 'next3' for convenient increment-by-one variants.+--+-- === __Examples__+-- @+-- layer1 = perlin2+-- layer2 = reseed (+1) perlin2+-- layer3 = reseed (+2) perlin2+--+-- combined = (layer1 + layer2 + layer3) / 3+-- @+reseed :: (Seed -> Seed) -> Noise p a -> Noise p a+reseed f (Noise g) = Noise (g . f)+{-# INLINE reseed #-}++constant :: a -> Noise c a+constant = pure+{-# INLINE constant #-}++-- | Combine two noise functions with a custom blending function.+--+-- This is an alias for 'liftA2'. Use it to mix multiple noise sources:+--+-- @+-- -- Multiply two noise functions+-- multiplied :: Noise2 Float+-- multiplied = blend (*) perlin2 superSimplex2+--+-- -- Custom blending based on values+-- custom :: Noise2 Float+-- custom = blend (\\a b -> if a > 0 then a else b) perlin2 superSimplex2+-- @+blend :: (a -> b -> c) -> Noise p a -> Noise p b -> Noise p c+blend = liftA2+{-# INLINE blend #-}++-- | Clamp a noise function between the given lower and higher bound+clampNoise :: (Ord a) => a -> a -> Noise p a -> Noise p a+clampNoise l u = fmap (clamp l u)+{-# INLINE clampNoise #-}++-- | Slice a 2D noise function at a fixed X coordinate to produce 1D noise.+--+-- === __Examples__+--+-- @+-- noise1d :: Noise1 Float+-- noise1d = sliceX2 0.0 perlin2 -- Fix X at 0, vary Y+--+-- -- Evaluate at Y = 5.0+-- value = noise1At noise1d seed 5.0+-- @+sliceX2 :: p -> Noise2' p v -> Noise1' p v+sliceX2 x = warp (x,)+{-# INLINE sliceX2 #-}++-- | Slice a 2D noise function at a fixed Y coordinate to produce 1D noise.+--+-- === __Examples__+--+-- @+-- noise1d :: Noise1 Float+-- noise1d = sliceY2 0.0 perlin2 -- Fix Y at 0, vary X+--+-- -- Evaluate at X = 5.0+-- value = noise1At noise1d seed 5.0+-- @+sliceY2 :: p -> Noise2' p v -> Noise1' p v+sliceY2 y = warp (,y)+{-# INLINE sliceY2 #-}++-- | Slice a 3D noise function at a fixed X coordinate to produce 2D noise.+--+-- === __Examples__+--+-- @+-- noise2d :: Noise2 Float+-- noise2d = sliceX3 0.0 perlin3 -- Fix X at 0, vary Y and Z+--+-- -- Evaluate at Y = 1.0, Z = 2.0+-- value = noise2At noise2d seed 1.0 2.0+-- @+sliceX3 :: p -> Noise3' p v -> Noise2' p v+sliceX3 x = warp (\(y, z) -> (x, y, z))+{-# INLINE sliceX3 #-}++-- | Slice a 3D noise function at a fixed Y coordinate to produce 2D noise.+--+-- === __Examples__+--+-- @+-- noise2d :: Noise2 Float+-- noise2d = sliceY3 0.0 perlin3 -- Fix Y at 0, vary X and Z+-- @+sliceY3 :: p -> Noise3' p v -> Noise2' p v+sliceY3 y = warp (\(x, z) -> (x, y, z))+{-# INLINE sliceY3 #-}++-- | Slice a 3D noise function at a fixed Z coordinate to produce 2D noise.+--+-- This is useful for extracting 2D slices from 3D noise at different heights:+--+-- === __Examples__+--+-- @+-- heightmap :: Noise2 Float+-- heightmap = sliceZ3 10.0 perlin3 -- Sample at Z = 10+-- @+sliceZ3 :: p -> Noise3' p v -> Noise2' p v+sliceZ3 z = warp (\(x, y) -> (x, y, z))+{-# INLINE sliceZ3 #-}++-- | Increment the seed for a 2D noise function. See 'reseed' next2 :: Noise2 a -> Noise2 a-next2 (Noise2 f) = Noise2 (\s x y -> f (s + 1) x y)+next2 = reseed (+ 1) {-# INLINE next2 #-} -map2 :: (a -> a) -> Noise2 a -> Noise2 a-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]@. 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)+clamp2 = clampNoise {-# INLINE clamp2 #-} +-- | A noise function that produces the same value everywhere. Alias of 'pure'. const2 :: a -> Noise2 a-const2 a = Noise2 (\_ _ _ -> a)+const2 = pure {-# INLINE const2 #-} -instance (Num a) => Num (Noise2 a) where- Noise2 f + Noise2 g = Noise2 $ \s x y -> f s x y + g s x y- {-# INLINE (+) #-}- Noise2 f * Noise2 g = Noise2 $ \s x y -> f s x y * g s x y- {-# INLINE (*) #-}- abs (Noise2 f) = Noise2 $ \s x y -> abs (f s x y)- {-# INLINE abs #-}- signum (Noise2 f) = Noise2 $ \s x y -> signum (f s x y)- {-# INLINE signum #-}- fromInteger i = const2 (fromInteger i)- {-# INLINE fromInteger #-}- negate (Noise2 f) = Noise2 $ \s x y -> negate (f s x y)- {-# INLINE negate #-}--instance (Fractional a) => Fractional (Noise2 a) where- fromRational r = const2 (fromRational r)- {-# INLINE fromRational #-}- recip (Noise2 f) = Noise2 $ \s x y -> recip (f s x y)- {-# INLINE recip #-}- Noise2 f / Noise2 g = Noise2 $ \s x y -> f s x y / g s x y- {-# INLINE (/) #-}--instance (Floating a) => Floating (Noise2 a) where- pi = const2 pi- {-# INLINE pi #-}- exp (Noise2 f) = Noise2 $ \s x y -> exp (f s x y)- {-# INLINE exp #-}- log (Noise2 f) = Noise2 $ \s x y -> log (f s x y)- {-# INLINE log #-}- sin (Noise2 f) = Noise2 $ \s x y -> sin (f s x y)- {-# INLINE sin #-}- cos (Noise2 f) = Noise2 $ \s x y -> cos (f s x y)- {-# INLINE cos #-}- asin (Noise2 f) = Noise2 $ \s x y -> asin (f s x y)- {-# INLINE asin #-}- acos (Noise2 f) = Noise2 $ \s x y -> acos (f s x y)- {-# INLINE acos #-}- atan (Noise2 f) = Noise2 $ \s x y -> atan (f s x y)- {-# INLINE atan #-}- sinh (Noise2 f) = Noise2 $ \s x y -> sinh (f s x y)- {-# INLINE sinh #-}- cosh (Noise2 f) = Noise2 $ \s x y -> cosh (f s x y)- {-# INLINE cosh #-}- asinh (Noise2 f) = Noise2 $ \s x y -> asinh (f s x y)- {-# INLINE asinh #-}- acosh (Noise2 f) = Noise2 $ \s x y -> acosh (f s x y)- {-# INLINE acosh #-}- atanh (Noise2 f) = Noise2 $ \s x y -> atanh (f s x y)- {-# INLINE atanh #-}--newtype Noise3 a = Noise3- {unNoise3 :: Seed -> a -> a -> a -> a}-+-- | Increment the seed for a 3D noise function. See 'reseed' next3 :: Noise3 a -> Noise3 a-next3 (Noise3 f) = Noise3 (\s x y z -> f (s + 1) x y z)+next3 = reseed (+ 1) {-# INLINE next3 #-} -map3 :: (a -> a) -> Noise3 a -> Noise3 a-map3 f (Noise3 g) = Noise3 (\s x y z -> f (g s x y z))-{-# INLINE map3 #-}-+-- | A noise function that produces the same value everywhere. Alias of 'pure'+--+-- Used to provide the 'Num' instance. const3 :: a -> Noise3 a-const3 a = Noise3 (\_ _ _ _ -> a)+const3 = pure {-# INLINE const3 #-} +-- | Clamp the output of a 3D noise function to the range @[lower, upper]@. 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)+clamp3 = clampNoise {-# INLINE clamp3 #-}--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 (+) #-}- Noise3 f * Noise3 g = Noise3 $ \s x y z -> f s x y z * g s x y z- {-# INLINE (*) #-}- abs (Noise3 f) = Noise3 $ \s x y z -> abs (f s x y z)- {-# INLINE abs #-}- signum (Noise3 f) = Noise3 $ \s x y z -> signum (f s x y z)- {-# INLINE signum #-}- fromInteger i = const3 (fromInteger i)- {-# INLINE fromInteger #-}- negate (Noise3 f) = Noise3 $ \s x y z -> negate (f s x y z)- {-# INLINE negate #-}--instance (Fractional a) => Fractional (Noise3 a) where- fromRational r = const3 (fromRational r)- {-# INLINE fromRational #-}- recip (Noise3 f) = Noise3 $ \s x y z -> recip (f s x y z)- {-# INLINE recip #-}--instance (Floating a) => Floating (Noise3 a) where- pi = const3 pi- {-# INLINE pi #-}- exp (Noise3 f) = Noise3 $ \s x y z -> exp (f s x y z)- {-# INLINE exp #-}- log (Noise3 f) = Noise3 $ \s x y z -> log (f s x y z)- {-# INLINE log #-}- sin (Noise3 f) = Noise3 $ \s x y z -> sin (f s x y z)- {-# INLINE sin #-}- cos (Noise3 f) = Noise3 $ \s x y z -> cos (f s x y z)- {-# INLINE cos #-}- asin (Noise3 f) = Noise3 $ \s x y z -> asin (f s x y z)- {-# INLINE asin #-}- acos (Noise3 f) = Noise3 $ \s x y z -> acos (f s x y z)- {-# INLINE acos #-}- atan (Noise3 f) = Noise3 $ \s x y z -> atan (f s x y z)- {-# INLINE atan #-}- sinh (Noise3 f) = Noise3 $ \s x y z -> sinh (f s x y z)- {-# INLINE sinh #-}- cosh (Noise3 f) = Noise3 $ \s x y z -> cosh (f s x y z)- {-# INLINE cosh #-}- asinh (Noise3 f) = Noise3 $ \s x y z -> asinh (f s x y z)- {-# INLINE asinh #-}- acosh (Noise3 f) = Noise3 $ \s x y z -> acosh (f s x y z)- {-# INLINE acosh #-}- atanh (Noise3 f) = Noise3 $ \s x y z -> atanh (f s x y z)- {-# INLINE atanh #-}
src/Numeric/Noise/Internal/Math.hs view
@@ -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@@ -46,25 +55,97 @@ -- ^ parameter in range [0, 1] -> a lerp v0 v1 t = v0 + t * (v1 - v0)-{-# INLINE lerp #-}+{-# INLINE [1] lerp #-} +{-# RULES+"lerp/Float/0" forall (a :: Float) b.+ lerp a b 0 =+ a+"lerp/Double/0" forall (a :: Double) b.+ lerp a b 0 =+ a+"lerp/Float/1" forall (a :: Float) b.+ lerp a b 1 =+ b+"lerp/Double/1" forall (a :: Double) b.+ lerp a b 1 =+ b+"lerp/id" forall a t. lerp a a t = a+"lerp/compose/start" forall a b t u.+ lerp (lerp a b u) b t =+ lerp a b (u + t - t * u)+"lerp/compose/end" forall a b t u.+ lerp a (lerp a b u) t =+ lerp a b (t * u)+ #-}+ -- | cubic interpolation cubicInterp :: (Num a) => a -> a -> a -> a -> a -> a-cubicInterp a b c d t =- let !p = (d - c) - (a - b)- in t * t * t * p + t * t * ((a - b) - p) + t * (c - a) + b-{-# INLINE cubicInterp #-}+cubicInterp a !b c d !t =+ let !c' = c - a+ !a' = a - b+ !p = (d - c) - a'+ !b' = a' - p+ in b + t * (c' + t * (b' + t * p))+{-# INLINE [1] cubicInterp #-} +{-# RULES+"cubicInterp/Float/0" forall (a :: Float) b c d.+ cubicInterp a b c d 0 =+ b+"cubicInterp/Double/0" forall (a :: Double) b c d.+ cubicInterp a b c d 0 =+ b+"cubicInterp/Float/1" forall (a :: Float) b c d.+ cubicInterp a b c d 1 =+ c+"cubicInterp/Double/1" forall (a :: Double) b c d.+ cubicInterp a b c d 1 =+ c+"cubicInterp/Float/0.5" forall (a :: Float) b c d.+ cubicInterp a b c d (0.5 :: Float) =+ 0.125 * (-a + 5 * b + 5 * c - d)+"cubicInterp/Double/0.5" forall (a :: Double) b c d.+ cubicInterp a b c d (0.5 :: Double) =+ 0.125 * (-a + 5 * b + 5 * c - d)+ #-}+ -- | hermite interpolation hermiteInterp :: (Num a) => a -> a hermiteInterp t = t * t * (3 - 2 * t)-{-# INLINE hermiteInterp #-}+{-# INLINE [1] hermiteInterp #-} +{-# RULES+"hermiteInterp/Float/0" hermiteInterp (0 :: Float) = 0+"hermiteInterp/Double/0" hermiteInterp (0 :: Double) = 0+"hermiteInterp/Float/1" hermiteInterp (1 :: Float) = 1+"hermiteInterp/Double/1" hermiteInterp (1 :: Double) = 1+ #-}+ -- | quintic interpolation quinticInterp :: (Num a) => a -> a quinticInterp t = t * t * t * (t * (t * 6 - 15) + 10)-{-# INLINE quinticInterp #-}+{-# INLINE [1] quinticInterp #-} +{-# RULES+"quinticInterp/Float/0"+ quinticInterp (0 :: Float) =+ 0+"quinticInterp/Double/0"+ quinticInterp (0 :: Double) =+ 0+"quinticInterp/Float/1"+ quinticInterp (1 :: Float) =+ 1+"quinticInterp/Double/1"+ quinticInterp (1 :: Double) =+ 1+ #-}++-- | Clamp a value to a specified range.+--+-- Returns the value if it's within bounds, otherwise returns+-- the nearest boundary. clamp :: (Ord a) => a@@ -74,10 +155,7 @@ -> a -- ^ value -> a-clamp l u v- | v < l = l- | v > u = u- | otherwise = v+clamp l u v = min (max v l) u {-# INLINE clamp #-} primeX, primeY, primeZ :: Hash@@ -112,48 +190,66 @@ sqrt3 = 1.7320508075688772935274463415059 {-# INLINE sqrt3 #-} -valCoord2 :: (RealFrac a) => Word64 -> Hash -> Hash -> a+valCoord2 :: (RealFrac a) => Seed -> Hash -> Hash -> a valCoord2 seed xPrimed yPrimed = let !hash = hash2 seed xPrimed yPrimed !val = (hash * hash) `xor` (hash `shiftL` 19)- in fromIntegral val / maxHash+ in fromIntegral val * recip (maxHash + 1) {-# INLINE valCoord2 #-} -valCoord3 :: (RealFrac a) => Word64 -> Hash -> Hash -> Hash -> a+valCoord3 :: (RealFrac a) => Seed -> Hash -> Hash -> Hash -> a valCoord3 seed xPrimed yPrimed zPrimed = let !hash = hash3 seed xPrimed yPrimed zPrimed !val = (hash * hash) `xor` (hash `shiftL` 19)- in fromIntegral val / maxHash+ in fromIntegral val * recip (maxHash + 1) {-# INLINE valCoord3 #-} gradCoord2 :: (RealFrac a) => Seed -> Hash -> Hash -> a -> a -> a 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)- in xd * realToFrac xg + yd * realToFrac yg-{-# INLINE gradCoord2 #-}+ !xg = lookupGrad2 ix+ !yg = lookupGrad2 (ix .|. 1)+ in xd * xg + yd * yg+-- Phase 2 inlining ensures specialization happens after hash computation+-- but before gradient lookup, allowing REWRITE RULES to fire effectively+{-# INLINE [2] gradCoord2 #-} gradCoord3 :: (RealFrac a) => Seed -> Hash -> Hash -> Hash -> a -> a -> a -> a 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)- in xd * fromIntegral xg + yd * fromIntegral yg + zd * fromIntegral zg+ !xg = lookupGrad3 ix+ !yg = lookupGrad3 (ix .|. 1)+ !zg = lookupGrad3 (ix .|. 2)+ in xd * xg + yd * yg + zd * zg {-# INLINE gradCoord3 #-} maxHash :: (RealFrac a) => a-maxHash = realToFrac (maxBound @Hash)+maxHash = fromIntegral (maxBound @Hash) {-# INLINE maxHash #-} +lookupGrad2 :: (RealFrac a) => Hash -> a+lookupGrad2 = realToFrac . (grad2dd `indexPrimArray`) . fromIntegral+{-# INLINE [0] lookupGrad2 #-}++{-# RULES+"lookupGrad2/Float" forall (i :: Hash).+ lookupGrad2 i =+ indexPrimArray grad2df (fromIntegral i)+"lookupGrad2/Double" forall (i :: Hash).+ lookupGrad2 i =+ indexPrimArray grad2dd (fromIntegral i)+ #-}++grad2df :: PrimArray Float+grad2df = mapPrimArray realToFrac grad2dd+ {- ORMOLU_DISABLE -}--- >>> U.length grad2d == 256+-- >>> sizeofPrimArray grad2d == 256 -- True-grad2d :: U.Vector Float-grad2d =+grad2dd :: PrimArray Double+grad2dd = [ 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, 0.793353340291235, -0.60876142900872 , 0.608761429008721, -0.793353340291235, 0.38268343236509 , -0.923879532511287, 0.130526192220052, -0.99144486137381,@@ -188,10 +284,29 @@ -0.38268343236509 , -0.923879532511287, -0.923879532511287, -0.38268343236509 , -0.923879532511287, 0.38268343236509 , -0.38268343236509 , 0.923879532511287 ] --- >>> U.length grad3d == 256+{- ORMOLU_ENABLE -}++lookupGrad3 :: (RealFrac a) => Hash -> a+lookupGrad3 = realToFrac . (grad3dd `indexPrimArray`) . fromIntegral+{-# INLINE [0] lookupGrad3 #-}++{-# RULES+"lookupGrad3/Float" forall (i :: Hash).+ lookupGrad3 i =+ indexPrimArray grad3df (fromIntegral i)+"lookupGrad3/Double" forall (i :: Hash).+ lookupGrad3 i =+ indexPrimArray grad3dd (fromIntegral i)+ #-}++grad3df :: PrimArray Float+grad3df = mapPrimArray realToFrac grad3dd++{- ORMOLU_DISABLE -}+-- >>> sizeofPrimArray grad3d == 256 -- True-grad3d :: U.Vector Int-grad3d =+grad3dd :: PrimArray Double+grad3dd = [ 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 , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
src/Numeric/Noise/OpenSimplex.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE Strict #-}- -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability: experimental@@ -11,76 +9,59 @@ noise2Base, ) where +import Data.Bool (bool) import Numeric.Noise.Internal import Numeric.Noise.Internal.Math noise2 :: (RealFrac a) => Noise2 a-noise2 = Noise2 noise2Base+noise2 = mkNoise2 noise2Base {-# INLINE noise2 #-} noise2Base :: (RealFrac a) => Seed -> a -> a -> a noise2Base seed xo yo =- let f2 = 0.5 * (sqrt3 - 1)- to = (xo + yo) * f2- x = xo + to- y = yo + to+ let !f2 = 0.5 * (sqrt3 - 1)+ !to = (xo + yo) * f2+ !x = xo + to+ !y = yo + to - fx = floor x- fy = floor y- xi = x - fromIntegral fx- yi = y - fromIntegral fy+ !fx = floor x+ !fy = floor y+ !xi = x - fromIntegral fx+ !yi = y - fromIntegral fy - t = (xi + yi) * g2- x0 = xi - t- y0 = yi - t- i = fx * primeX- j = fy * primeY+ !t = (xi + yi) * g2+ !x0 = xi - t+ !y0 = yi - t+ !i = fx * primeX+ !j = fy * primeY - a = 0.5 - x0 * x0 - y0 * y0- n0- | a <= 0 = 0- | otherwise =- (a * a)- * (a * a)- * gradCoord2 seed i j x0 y0+ !a = 0.5 - x0 * x0 - y0 * y0+ n0 = attenuate a seed i j x0 y0 - n1- | y0 > x0 =- let ~x1 = x0 + g2- ~i1 = i- ~y1 = y0 + (g2 - 1)- ~j1 = j + primeY- ~b = 0.5 - x1 * x1 - y1 * y1- in if b <= 0- then 0- else- (b * b)- * (b * b)- * gradCoord2 seed i1 j1 x1 y1- | otherwise =- let ~x1 = x0 + (g2 - 1)- ~i1 = i + primeX- ~y1 = y0 + g2- ~j1 = j- ~b = 0.5 - x1 * x1 - y1 * y1- in if b <= 0- then 0- else- (b * b)- * (b * b)- * gradCoord2 seed i1 j1 x1 y1+ n1 =+ let cond = bool 0 1 (y0 > x0)+ x1 = (x0 + g2 - 1) + fromIntegral cond+ y1 = (y0 + g2) - fromIntegral cond+ i1 = i + (1 - cond) * primeX+ j1 = j + cond * primeY+ b = 0.5 - x1 * x1 - y1 * y1+ in attenuate b seed i1 j1 x1 y1 - c =+ !n2 = let g2t = 1 - 2 * g2- in 2 * g2t * (1 / g2 - 2) * t- + (-2 * g2t * g2t + a)- n2- | c <= 0 = 0- | otherwise =- let ~x2 = x0 + (2 * g2 - 1)- ~y2 = y0 + (2 * g2 - 1)- in (c * c)- * (c * c)- * gradCoord2 seed (i + primeX) (j + primeY) x2 y2- in (n0 + n1 + n2) * 99.83685446303647-{-# INLINE noise2Base #-}+ c = 2 * g2t * (1 / g2 - 2) * t + (-2 * g2t * g2t + a)+ x2 = x0 + (2 * g2 - 1)+ y2 = y0 + (2 * g2 - 1)+ in attenuate c seed (i + primeX) (j + primeY) x2 y2+ in normalize $ n0 + n1 + n2+{-# INLINE [2] noise2Base #-}++attenuate :: (RealFrac a) => a -> Seed -> Hash -> Hash -> a -> a -> a+attenuate !vi seed i j x y =+ let !v = max 0 vi+ in (v * v) * (v * v) * gradCoord2 seed i j x y+{-# INLINE attenuate #-}++normalize :: (RealFrac a) => a -> a+normalize = (99.83685446303647 *)+{-# INLINE normalize #-}
src/Numeric/Noise/Perlin.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE Strict #-}- -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability : experimental@@ -18,7 +16,7 @@ import Numeric.Noise.Internal.Math noise2 :: (RealFrac a) => Noise2 a-noise2 = Noise2 noise2Base+noise2 = mkNoise2 noise2Base {-# INLINE noise2 #-} noise2Base :: forall a. (RealFrac a) => Seed -> a -> a -> a@@ -39,8 +37,8 @@ x1p = x0p + primeX y1p = y0p + primeY- in 1.4247691104677813- * lerp+ in normalize2 $+ lerp ( lerp (gradCoord2 seed x0p y0p xd0 yd0) (gradCoord2 seed x1p y0p xd1 yd0)@@ -52,10 +50,14 @@ u ) v-{-# INLINE noise2Base #-}+{-# INLINE [2] noise2Base #-} +normalize2 :: (RealFrac a) => a -> a+normalize2 = (1.4247691104677813 *)+{-# INLINE normalize2 #-}+ noise3 :: (RealFrac a) => Noise3 a-noise3 = Noise3 noise3Base+noise3 = mkNoise3 noise3Base {-# INLINE noise3 #-} noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a@@ -82,8 +84,8 @@ x1p = x0p + primeX y1p = y0p + primeY z1p = z0p + primeZ- in 0.96492141485214233398437- * lerp+ in normalize3 $+ lerp ( lerp ( lerp (gradCoord3 seed x0p y0p z0p xd0 yd0 zd0)@@ -111,4 +113,8 @@ v ) w-{-# INLINE noise3Base #-}+{-# INLINE [2] noise3Base #-}++normalize3 :: (RealFrac a) => a -> a+normalize3 = (0.96492141485214233398437 *)+{-# INLINE normalize3 #-}
src/Numeric/Noise/SuperSimplex.hs view
@@ -17,7 +17,7 @@ import Numeric.Noise.Internal.Math noise2 :: (RealFrac a) => Noise2 a-noise2 = Noise2 noise2Base+noise2 = mkNoise2 noise2Base {-# INLINE noise2 #-} noise2Base :: (RealFrac a) => Seed -> a -> a -> a@@ -60,89 +60,60 @@ let ~x2 = x0 + (3 * g2 - 2) ~y2 = y0 + (3 * g2 - 1) ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed (i + (primeX `shiftL` 1)) (j + primeY) x2 y2- else 0+ in attenuate a2 seed (i + (primeX `shiftL` 1)) (j + primeY) x2 y2 | otherwise = let ~x2 = x0 + g2 ~y2 = y0 + (g2 - 1) ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed i (j + primeY) x2 y2- else 0+ in attenuate a2 seed i (j + primeY) x2 y2+ ~vgy | yi - xmyi > 1 = let ~x3 = x0 + (3 * g2 - 1) ~y3 = y0 + (3 * g2 - 2) ~a3 = (2 / 3) - x3 * x3 - y3 * y3- in if a3 > 0- then- (a3 * a3)- * (a3 * a3)- * gradCoord2 seed (i + primeX) (j + (primeY `shiftL` 1)) x3 y3- else 0+ in attenuate a3 seed (i + primeX) (j + (primeY `shiftL` 1)) x3 y3 | otherwise = let ~x3 = x0 + (g2 - 1) ~y3 = y0 + g2 ~a3 = (2 / 3) - x3 * x3 - y3 * y3- in if a3 > 0- then- (a3 * a3)- * (a3 * a3)- * gradCoord2 seed (i + primeX) j x3 y3- else 0+ in attenuate a3 seed (i + primeX) j x3 y3 ~vlx | xi + xmyi < 0 = let ~x2 = x0 + (1 - g2) ~y2 = y0 - g2 ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed (i - primeX) j x2 y2- else 0+ in attenuate a2 seed (i - primeX) j x2 y2 | otherwise = let ~x2 = x0 + (g2 - 1) ~y2 = y0 + g2 ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed (i + primeX) j x2 y2- else 0+ in attenuate a2 seed (i + primeX) j x2 y2 ~vly | yi < xmyi = let ~x2 = x0 - g2 ~y2 = y0 - (g2 - 1) ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed i (j - primeY) x2 y2- else 0+ in attenuate a2 seed i (j - primeY) x2 y2 | otherwise = let ~x2 = x0 + g2 ~y2 = y0 + (g2 - 1) ~a2 = (2 / 3) - x2 * x2 - y2 * y2- in if a2 > 0- then- (a2 * a2)- * (a2 * a2)- * gradCoord2 seed i (j + primeY) x2 y2- else 0+ in attenuate a2 seed i (j + primeY) x2 y2 v2 | t > g2 = vgx + vgy | otherwise = vlx + vly- in (v0 + v1 + v2) * 18.24196194486065-{-# INLINE noise2Base #-}+ in normalize $ v0 + v1 + v2+{-# INLINE [2] noise2Base #-}++attenuate :: (RealFrac a) => a -> Seed -> Hash -> Hash -> a -> a -> a+attenuate !vi !seed !i !j !x !y =+ let !v = max 0 vi+ in (v * v) * (v * v) * gradCoord2 seed i j x y+{-# INLINE attenuate #-}++normalize :: (RealFrac a) => a -> a+normalize = (18.24196194486065 *)+{-# INLINE normalize #-}
src/Numeric/Noise/Value.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE Strict #-}- -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability: experimental@@ -20,7 +18,7 @@ import Numeric.Noise.Internal.Math noise2 :: (RealFrac a) => Noise2 a-noise2 = Noise2 noise2Base+noise2 = mkNoise2 noise2Base {-# INLINE noise2 #-} noise2Base :: (RealFrac a) => Seed -> a -> a -> a@@ -48,10 +46,10 @@ xs ) ys-{-# INLINE noise2Base #-}+{-# INLINE [2] noise2Base #-} noise3 :: (RealFrac a) => Noise3 a-noise3 = Noise3 noise3Base+noise3 = mkNoise3 noise3Base {-# INLINE noise3 #-} noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a@@ -99,4 +97,4 @@ ys ) zs-{-# INLINE noise3Base #-}+{-# INLINE [2] noise3Base #-}
src/Numeric/Noise/ValueCubic.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE Strict #-}- -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability : experimental@@ -18,7 +16,7 @@ import Numeric.Noise.Internal.Math noise2 :: (RealFrac a) => Noise2 a-noise2 = Noise2 noise2Base+noise2 = mkNoise2 noise2Base {-# INLINE noise2 #-} noise2Base :: (RealFrac a) => Seed -> a -> a -> a@@ -68,10 +66,10 @@ xs ) ys-{-# INLINE noise2Base #-}+{-# INLINE [2] noise2Base #-} noise3 :: (RealFrac a) => Noise3 a-noise3 = Noise3 noise3Base+noise3 = mkNoise3 noise3Base {-# INLINE noise3 #-} noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a@@ -223,4 +221,4 @@ ys ) zs-{-# INLINE noise3Base #-}+{-# INLINE [2] noise3Base #-}
+ test/CellularSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module CellularSpec (test_golden_cellular) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_cellular :: TestTree+test_golden_cellular =+ testGroup+ "Cellular Golden Tests"+ [ testGroup "Grid Tests" cellularGridTests+ , testGroup "Sparse Tests" cellularSparseTests+ ]++-- All combinations of distance functions and result types+allCellularConfigs :: [(CellularDistanceFn, CellularResult)]+allCellularConfigs = [(df, rt) | df <- [minBound .. maxBound], rt <- [minBound .. maxBound]]++cellularGridTests :: [TestTree]+cellularGridTests =+ [ goldenImageTest2D "cellular" variant (cellular2 config) seed+ | (distFn, result) <- allCellularConfigs+ , let config = defaultCellularConfig{cellularDistanceFn = distFn, cellularResult = result}+ , seed <- cellularSeeds+ , let variant = show distFn ++ "-" <> show result <> "-seed" ++ show seed+ ]++cellularSparseTests :: [TestTree]+cellularSparseTests =+ [ goldenSparseTest2D "cellular" variant (cellular2 config) seed+ | (distFn, result) <- allCellularConfigs+ , let config = defaultCellularConfig{cellularDistanceFn = distFn, cellularResult = result}+ , seed <- cellularSeeds+ , let variant = show distFn <> "-" <> show result <> "-seed" ++ show seed+ ]
+ test/FractalSpec.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module FractalSpec (test_golden_fractal) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_fractal :: TestTree+test_golden_fractal =+ testGroup+ "Fractal Golden Tests"+ [ testGroup "2D Grid Tests" fractal2DGridTests+ , testGroup "2D Sparse Tests" fractal2DSparseTests+ , testGroup "3D Grid Tests" fractal3DGridTests+ , testGroup "3D Sparse Tests" fractal3DSparseTests+ ]++-- Fractal types to test+data FractalType = FBM | Billow | Ridged | PingPong+ deriving (Show, Eq, Enum, Bounded)++-- Apply the fractal type to a 2D noise function+applyFractal2D :: FractalType -> Noise2 Double -> Noise2 Double+applyFractal2D FBM = fractal2 defaultFractalConfig+applyFractal2D Billow = billow2 defaultFractalConfig+applyFractal2D Ridged = ridged2 defaultFractalConfig+applyFractal2D PingPong = pingPong2 defaultFractalConfig defaultPingPongStrength++-- Apply the fractal type to a 3D noise function+applyFractal3D :: FractalType -> Noise3 Double -> Noise3 Double+applyFractal3D FBM = fractal3 defaultFractalConfig+applyFractal3D Billow = billow3 defaultFractalConfig+applyFractal3D Ridged = ridged3 defaultFractalConfig+applyFractal3D PingPong = pingPong3 defaultFractalConfig defaultPingPongStrength++fractal2DGridTests :: [TestTree]+fractal2DGridTests =+ [ goldenImageTest2D "fractal" variant (applyFractal2D fractalType perlin2) seed+ | fractalType <- [minBound .. maxBound]+ , seed <- cellularSeeds+ , let variant = show fractalType ++ "-perlin-2d-seed" ++ show seed+ ]++fractal2DSparseTests :: [TestTree]+fractal2DSparseTests =+ [ goldenSparseTest2D "fractal" variant (applyFractal2D fractalType perlin2) seed+ | fractalType <- [minBound .. maxBound]+ , seed <- cellularSeeds+ , let variant = show fractalType ++ "-perlin-2d-seed" ++ show seed+ ]++fractal3DGridTests :: [TestTree]+fractal3DGridTests =+ [ goldenImageTest3D "fractal" variant (applyFractal3D fractalType perlin3) seed zOffset+ | fractalType <- [minBound .. maxBound]+ , seed <- cellularSeeds+ , (idx, zOffset) <- zip [0 :: Int ..] sliceOffsets3D+ , let variant = show fractalType ++ "-perlin-3d-seed_" ++ show seed ++ "-slice_" ++ show idx+ ]++fractal3DSparseTests :: [TestTree]+fractal3DSparseTests =+ [ goldenSparseTest3D "fractal" variant (applyFractal3D fractalType perlin3) seed+ | fractalType <- [minBound .. maxBound]+ , seed <- cellularSeeds+ , let variant = show fractalType ++ "-perlin-3d-seed" ++ show seed+ ]
+ test/Golden/Util.hs view
@@ -0,0 +1,393 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Utilities for golden testing of noise functions+module Golden.Util (+ -- * Test configuration+ defaultSeeds,+ cellularSeeds,+ sliceOffsets3D,++ -- * Grid generation+ generateGrid2D,+ generateGrid3D,++ -- * Sparse sampling+ SparseTest (..),+ generateSparse2D,+ generateSparse3D,++ -- * High-level test builders+ goldenImageTest2D,+ goldenImageTest3D,+ goldenSparseTest2D,+ goldenSparseTest3D,++ -- * Convenience batch functions+ golden2DImageTests,+ golden2DSparseTests,+ golden3DImageTests,+ golden3DSparseTests,+) where++import Codec.Picture+import Control.Monad+import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LB+import Data.Massiv.Array (Array, B (..), Comp (..), Ix2 (..), Ix3, IxN (..), Sz (..))+import Data.Massiv.Array qualified as M+import Data.Text.Lazy qualified as LT+import Data.Text.Lazy.Encoding qualified as LT+import Foreign.C (eNOENT)+import Foreign.C.Error (errnoToIOError)+import GHC.Generics (Generic)+import Numeric.Noise (Noise2, Noise3, Seed, noise2At, noise3At, sliceZ3)+import System.Directory+import System.Exit+import System.FilePath+import System.Process.Typed qualified as PT+import Test.Tasty (TestName, TestTree, askOption)+import Test.Tasty.Golden+import Test.Tasty.Golden.Advanced (goldenTest2)++defaultSeeds :: [Seed]+defaultSeeds = [0, 42, 12345]++cellularSeeds :: [Seed]+cellularSeeds = [0, 42]++width2D, height2D :: Int+width2D = 1024+height2D = 1024++width3D, height3D :: Int+width3D = 256+height3D = 256++-- | Z-offsets for 3D slicing (fractional positions avoiding edges)+sliceOffsets3D :: [Double]+sliceOffsets3D = [0.125, 0.375, 0.625, 0.875]++data SparseTest a = SparseTest+ { coordinates :: [a]+ , expected :: a+ }+ deriving (Eq, Show, Generic)++instance (FromJSON a) => FromJSON (SparseTest a)+instance (ToJSON a) => ToJSON (SparseTest a)++-- | Generate a 2D noise grid using massiv+generateGrid2D+ :: Noise2 Double+ -> Seed+ -> Int+ -- ^ Width+ -> Int+ -- ^ Height+ -> Array B Ix2 Double+generateGrid2D noise seed width height =+ M.makeArray Par (Sz2 height width) $ \(row :. col) ->+ let x = fromIntegral col / fromIntegral width+ y = fromIntegral row / fromIntegral height+ in noise2At noise seed x y+{-# INLINE generateGrid2D #-}++-- | Generate a 3D noise grid using massiv+generateGrid3D+ :: Noise3 Double+ -> Seed+ -> Int+ -- ^ Width+ -> Int+ -- ^ Height+ -> Int+ -- ^ Depth+ -> Array B Ix3 Double+generateGrid3D noise seed width height depth =+ M.makeArray Par (Sz3 depth height width) $ \(d :> row :. col) ->+ let x = fromIntegral col / fromIntegral width+ y = fromIntegral row / fromIntegral height+ z = fromIntegral d / fromIntegral depth+ in noise3At noise seed x y z+{-# INLINE generateGrid3D #-}++-- | Convert a 2D noise grid to a grayscale PNG image+-- Maps noise values from [-1, 1] to pixel values [0, 255]+noiseGridToImage :: Array B Ix2 Double -> Image Pixel8+noiseGridToImage arr =+ let Sz2 height width = M.size arr+ getPixel x y =+ let val = arr M.! (y :. x)+ -- Map [-1, 1] to [0, 255]+ normalized = (val + 1.0) / 2.0+ clamped = max 0.0 (min 1.0 normalized)+ in round (clamped * 255.0)+ in generateImage getPixel width height+{-# INLINE noiseGridToImage #-}++-- | Strategic test points for 2D noise+-- Includes corners, edges, zero, unit values, negatives, and fractional coordinates+sparseTestPoints2D :: [(Double, Double)]+sparseTestPoints2D =+ [ -- Corners and edges+ (0.0, 0.0)+ , (1.0, 1.0)+ , (0.0, 1.0)+ , (1.0, 0.0)+ , -- Negative values+ (-1.0, -1.0)+ , (-1.0, 0.0)+ , (0.0, -1.0)+ , (-1.0, 1.0)+ , (1.0, -1.0)+ , -- Fractional coordinates+ (0.5, 0.5)+ , (0.25, 0.75)+ , (0.75, 0.25)+ , (0.1, 0.9)+ , (0.9, 0.1)+ , -- Larger values+ (10.0, 10.0)+ , (100.0, 100.0)+ , (-10.0, -10.0)+ , (5.5, 7.3)+ , (-3.2, 4.7)+ , -- Edge cases+ (1.0e-10, 1.0e-10)+ , (1.0e10, 1.0e10)+ , -- More varied points+ (2.5, 3.7)+ , (-5.2, 8.9)+ , (12.34, -56.78)+ , (0.123, 0.456)+ , (0.789, 0.321)+ , (-0.5, -0.5)+ , (0.5, -0.5)+ , (-0.5, 0.5)+ , -- Prime-like coordinates for good distribution+ (2.0, 3.0)+ , (5.0, 7.0)+ , (11.0, 13.0)+ , (17.0, 19.0)+ , (23.0, 29.0)+ , (31.0, 37.0)+ , (41.0, 43.0)+ , (47.0, 53.0)+ , -- Diagonal patterns+ (2.0, 2.0)+ , (3.0, 3.0)+ , (-2.0, -2.0)+ , -- Anti-diagonal+ (2.0, -2.0)+ , (-2.0, 2.0)+ , -- Discontinuity+ (0.999999, 0.999999)+ , (0.000001, 0.000001)+ , (0.999999999, 0.999999999)+ , (1.000000001, 1.000000001)+ , -- Powers of two+ (256.0, 256.0)+ , (1024.0, 1024.1)+ , (65536.5, 65536.5)+ , -- Large inputs+ (10000.0, 10000.0)+ , (10000.1, 10000.1)+ , -- Floating-point tomfoolery+ (1 / 0, 1.0) -- infinity+ , (-1 / 0, 1.0) -- negative infinity+ , (0 / 0, 1.0) -- NaN+ ]++-- | Strategic test points for 3D noise+sparseTestPoints3D :: [(Double, Double, Double)]+sparseTestPoints3D =+ [ -- Corners+ (0.0, 0.0, 0.0)+ , (1.0, 1.0, 1.0)+ , (0.0, 0.0, 1.0)+ , (0.0, 1.0, 0.0)+ , (1.0, 0.0, 0.0)+ , (0.0, 1.0, 1.0)+ , (1.0, 0.0, 1.0)+ , (1.0, 1.0, 0.0)+ , -- Negative corners+ (-1.0, -1.0, -1.0)+ , (-1.0, -1.0, 1.0)+ , (-1.0, 1.0, -1.0)+ , (1.0, -1.0, -1.0)+ , -- Fractional center and edges+ (0.5, 0.5, 0.5)+ , (0.25, 0.5, 0.75)+ , (0.75, 0.25, 0.5)+ , -- Larger values+ (10.0, 10.0, 10.0)+ , (100.0, 100.0, 100.0)+ , (-10.0, -10.0, -10.0)+ , -- Varied points+ (2.5, 3.7, 4.2)+ , (-5.2, 8.9, -3.1)+ , (1.23, -4.56, 7.89)+ , -- Edge cases+ (1.0e-10, 1.0e-10, 1.0e-10)+ , (1.0e10, 1.0e10, 1.0e10)+ , -- Mixed signs+ (1.0, -1.0, 1.0)+ , (-1.0, 1.0, -1.0)+ , (1.0, 1.0, -1.0)+ , (-1.0, -1.0, 1.0)+ , -- Prime-like distribution+ (2.0, 3.0, 5.0)+ , (7.0, 11.0, 13.0)+ , (17.0, 19.0, 23.0)+ ]++-- | Generate sparse test samples for 2D noise+generateSparse2D :: Noise2 Double -> Seed -> [SparseTest Double]+generateSparse2D noise seed =+ map (\(x, y) -> SparseTest [x, y] (noise2At noise seed x y)) sparseTestPoints2D++-- | Generate sparse test samples for 3D noise+generateSparse3D :: Noise3 Double -> Seed -> [SparseTest Double]+generateSparse3D noise seed =+ map (\(x, y, z) -> SparseTest [x, y, z] (noise3At noise seed x y z)) sparseTestPoints3D++-- -----------------------------------------------------------------------------+-- High-level test builders+-- -----------------------------------------------------------------------------++goldenDir :: FilePath+goldenDir = "test-data" </> "golden"++goldenImageTest :: String -> String -> (String -> IO ()) -> TestTree+goldenImageTest noiseName variant act =+ let testName = noiseName <> " " <> variant+ imageRoot = goldenDir </> "images" </> noiseName+ goldenPath = imageRoot </> variant <.> "png"+ actualPath = imageRoot </> variant <.> "actual" <.> "png"+ in goldenVsImage+ testName+ goldenPath+ actualPath+ (createDirectoryIfMissing True imageRoot >> act actualPath)++-- This is more-or-less the same as goldenVsFileDiff, but it doesn't share stdio with+-- the child process, which is pretty important because odiff doesn't have a quiet option+goldenVsImage :: TestName -> FilePath -> FilePath -> IO () -> TestTree+goldenVsImage name ref new act = askOption $ \sizeCutoff ->+ goldenTest2+ name+ throwIfDoesNotExist+ act+ (\_ _ -> runDiff sizeCutoff)+ update+ delete+ where+ throwIfDoesNotExist = do+ exists <- doesFileExist ref+ unless exists $+ ioError $+ errnoToIOError "goldenVsFileDiff" eNOENT Nothing Nothing+ runDiff+ :: SizeCutoff+ -> IO (Maybe String)+ runDiff sizeCutoff = do+ let (refName, refExt) = splitExtension ref+ proc =+ PT.proc+ "odiff"+ [ "-t"+ , "0.004" -- Tolerate roughly +/- 1 error for 8-bit grayscale.+ , "--diff-overlay"+ , "--fail-on-layout"+ , "--output-diff-lines"+ , ref+ , new+ , refName <.> "diff" <.> refExt+ ]+ procConf = PT.setStdin PT.closed proc++ (exitCode, out) <- PT.readProcessInterleaved procConf+ return $ case exitCode of+ ExitSuccess -> Nothing+ _ -> Just . LT.unpack . LT.decodeUtf8 . truncateLargeOutput sizeCutoff $ out+ truncateLargeOutput (SizeCutoff n) str =+ if LB.length str <= n+ then str+ else+ LB.take n str+ <> "<truncated>"+ <> "\nUse --accept or increase --size-cutoff to see full output."+ update _ = do+ f <- BS.readFile new+ createDirectoriesAndWriteFile ref (LB.fromStrict f)+ delete = removeFile new++goldenImageTest2D :: String -> String -> Noise2 Double -> Seed -> TestTree+goldenImageTest2D noiseName variant noise seed = goldenImageTest noiseName variant $ \path -> do+ let grid = generateGrid2D noise seed width2D height2D+ img = noiseGridToImage grid+ savePngImage path (ImageY8 img)++goldenImageTest3D :: String -> String -> Noise3 Double -> Seed -> Double -> TestTree+goldenImageTest3D noiseName variant noise seed zOffset = goldenImageTest noiseName variant $ \path -> do+ let grid2D = generateGrid2D (sliceZ3 zOffset noise) seed width3D height3D+ img = noiseGridToImage grid2D+ savePngImage path (ImageY8 img)++goldenSparseTest :: String -> String -> (String -> IO ()) -> TestTree+goldenSparseTest noiseName variant act =+ let testName = noiseName <> " " <> variant <> " (sparse)"+ jsonRoot = goldenDir </> "sparse" </> noiseName+ goldenPath = jsonRoot </> variant <.> "json"+ actualPath = jsonRoot </> variant <.> "actual" <.> "json"+ in goldenVsFileDiff+ testName+ (\ref new -> ["diff", "-u", ref, new])+ goldenPath+ actualPath+ (createDirectoryIfMissing True jsonRoot >> act actualPath)++goldenSparseTest2D :: String -> String -> Noise2 Double -> Seed -> TestTree+goldenSparseTest2D noiseName variant noise seed = goldenSparseTest noiseName variant $ \path -> do+ let samples = generateSparse2D noise seed+ json = encodePretty samples+ LB.writeFile path json++goldenSparseTest3D :: String -> String -> Noise3 Double -> Seed -> TestTree+goldenSparseTest3D noiseName variant noise seed = goldenSparseTest noiseName variant $ \path -> do+ let samples = generateSparse3D noise seed+ json = encodePretty samples+ LB.writeFile path json++labelBatch :: (Show a) => String -> a -> String+labelBatch dim seed = dim <> "-seed_" <> show seed++labelBatch3D :: Seed -> Int -> String+labelBatch3D seed sliceIdx = "3d-seed_" <> show seed <> "-slice_" <> show sliceIdx++golden2DImageTests :: String -> [Seed] -> Noise2 Double -> [TestTree]+golden2DImageTests noiseName seeds noise =+ [ goldenImageTest2D noiseName (labelBatch "2d" seed) noise seed+ | seed <- seeds+ ]++golden2DSparseTests :: String -> [Seed] -> Noise2 Double -> [TestTree]+golden2DSparseTests noiseName seeds noise =+ [ goldenSparseTest2D noiseName (labelBatch "2d" seed) noise seed+ | seed <- seeds+ ]++golden3DImageTests :: String -> [Seed] -> Noise3 Double -> [TestTree]+golden3DImageTests noiseName seeds noise =+ [ goldenImageTest3D noiseName (labelBatch3D seed idx) noise seed zOffset+ | seed <- seeds+ , (idx, zOffset) <- zip [0 ..] sliceOffsets3D+ ]++golden3DSparseTests :: String -> [Seed] -> Noise3 Double -> [TestTree]+golden3DSparseTests noiseName seeds noise =+ [ goldenSparseTest3D noiseName (labelBatch "3d" seed) noise seed+ | seed <- seeds+ ]
test/Noise2Spec.hs view
@@ -1,7 +1,6 @@ module Noise2Spec where import Numeric.Noise-import Numeric.Noise.Internal seed :: Seed seed = 55@@ -25,12 +24,12 @@ prop_0_is_additive_identity :: Rational -> Rational -> Rational -> Bool prop_0_is_additive_identity v x y = let n1 = const2 v- in noise2At (n1 + fromInteger 0) seed x y == noise2At n1 seed x y+ in noise2At (n1 + 0) seed x y == noise2At n1 seed x y prop_negate_is_additive_inverse :: Rational -> Rational -> Rational -> Bool prop_negate_is_additive_inverse v x y = let n1 = const2 v- in noise2At (n1 + negate n1) seed x y == 0+ in noise2At (n1 - n1) seed x y == 0 prop_multiplication :: Rational -> Rational -> Bool prop_multiplication x y = noise2At (const2 x * const2 y) seed x y == x * y@@ -41,8 +40,3 @@ n2 = const2 2027 n3 = const2 2069 in noise2At ((n1 * n2) * n3) seed x y == noise2At (n1 * (n2 * n3)) seed x y--prop_1_is_multiplicative_identity :: Rational -> Rational -> Rational -> Bool-prop_1_is_multiplicative_identity v x y =- let n1 = const2 v- in noise2At (n1 * fromInteger 1) seed x y == v
test/Noise3Spec.hs view
@@ -1,7 +1,6 @@ module Noise3Spec where import Numeric.Noise-import Numeric.Noise.Internal seed :: Seed seed = 2381@@ -26,12 +25,12 @@ prop_0_is_additive_identity :: Rational -> Rational -> Rational -> Rational -> Bool prop_0_is_additive_identity v x y z = let n1 = const3 v- in noise3At (n1 + fromInteger 0) seed x y z == noise3At n1 seed x y z+ in noise3At (n1 + 0) seed x y z == noise3At n1 seed x y z prop_negate_is_additive_inverse :: Rational -> Rational -> Rational -> Rational -> Bool prop_negate_is_additive_inverse v x y z = let n1 = const3 v- in noise3At (n1 + negate n1) seed x y z == 0+ in noise3At (n1 - n1) seed x y z == 0 prop_multiplication :: Rational -> Rational -> Rational -> Bool prop_multiplication x y z =@@ -47,4 +46,4 @@ prop_1_is_multiplicative_identity :: Rational -> Rational -> Rational -> Rational -> Bool prop_1_is_multiplicative_identity v x y z = let n1 = const3 v- in noise3At (n1 * fromInteger 1) seed x y z == v+ in noise3At (n1 * 1) seed x y z == v
+ test/OpenSimplexSpec.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++module OpenSimplexSpec (test_golden_opensimplex) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_opensimplex :: TestTree+test_golden_opensimplex =+ testGroup+ "OpenSimplex Golden Tests"+ [ testGroup "2D Grid Tests" openSimplex2DGridTests+ , testGroup "2D Sparse Tests" openSimplex2DSparseTests+ ]++openSimplex2DGridTests :: [TestTree]+openSimplex2DGridTests = golden2DImageTests "opensimplex" defaultSeeds openSimplex2++openSimplex2DSparseTests :: [TestTree]+openSimplex2DSparseTests = golden2DSparseTests "opensimplex" defaultSeeds openSimplex2
test/PerlinSpec.hs view
@@ -1,6 +1,9 @@ module PerlinSpec where +import GHC.Exts (noinline)+import Golden.Util import Numeric.Noise+import Test.Tasty (TestTree, testGroup) seed :: Seed seed = 82384@@ -12,8 +15,32 @@ 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++test_golden_perlin :: TestTree+test_golden_perlin =+ testGroup+ "Perlin Golden Tests"+ [ testGroup "2D Grid Tests" perlin2DGridTests+ , testGroup "2D Sparse Tests" perlin2DSparseTests+ , testGroup "3D Grid Tests" perlin3DGridTests+ , testGroup "3D Sparse Tests" perlin3DSparseTests+ ]++perlin2DGridTests :: [TestTree]+perlin2DGridTests = golden2DImageTests "perlin" defaultSeeds perlin2++perlin2DSparseTests :: [TestTree]+perlin2DSparseTests = golden2DSparseTests "perlin" defaultSeeds perlin2++perlin3DGridTests :: [TestTree]+perlin3DGridTests = golden3DImageTests "perlin" defaultSeeds perlin3++perlin3DSparseTests :: [TestTree]+perlin3DSparseTests = golden3DSparseTests "perlin" defaultSeeds perlin3
+ test/SuperSimplexSpec.hs view
@@ -0,0 +1,19 @@+module SuperSimplexSpec (test_golden_supersimplex) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_supersimplex :: TestTree+test_golden_supersimplex =+ testGroup+ "SuperSimplex Golden Tests"+ [ testGroup "2D Grid Tests" superSimplex2DGridTests+ , testGroup "2D Sparse Tests" superSimplex2DSparseTests+ ]++superSimplex2DGridTests :: [TestTree]+superSimplex2DGridTests = golden2DImageTests "supersimplex" defaultSeeds superSimplex2++superSimplex2DSparseTests :: [TestTree]+superSimplex2DSparseTests = golden2DSparseTests "supersimplex" defaultSeeds superSimplex2
+ test/ValueCubicSpec.hs view
@@ -0,0 +1,27 @@+module ValueCubicSpec (test_golden_valuecubic) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_valuecubic :: TestTree+test_golden_valuecubic =+ testGroup+ "ValueCubic Golden Tests"+ [ testGroup "2D Grid Tests" valueCubic2DGridTests+ , testGroup "2D Sparse Tests" valueCubic2DSparseTests+ , testGroup "3D Grid Tests" valueCubic3DGridTests+ , testGroup "3D Sparse Tests" valueCubic3DSparseTests+ ]++valueCubic2DGridTests :: [TestTree]+valueCubic2DGridTests = golden2DImageTests "valuecubic" defaultSeeds valueCubic2++valueCubic2DSparseTests :: [TestTree]+valueCubic2DSparseTests = golden2DSparseTests "valuecubic" defaultSeeds valueCubic2++valueCubic3DGridTests :: [TestTree]+valueCubic3DGridTests = golden3DImageTests "valuecubic" defaultSeeds valueCubic3++valueCubic3DSparseTests :: [TestTree]+valueCubic3DSparseTests = golden3DSparseTests "valuecubic" defaultSeeds valueCubic3
+ test/ValueSpec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module ValueSpec (test_golden_value) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_value :: TestTree+test_golden_value =+ testGroup+ "Value Golden Tests"+ [ testGroup "2D Grid Tests" value2DGridTests+ , testGroup "2D Sparse Tests" value2DSparseTests+ , testGroup "3D Grid Tests" value3DGridTests+ , testGroup "3D Sparse Tests" value3DSparseTests+ ]++value2DGridTests :: [TestTree]+value2DGridTests = golden2DImageTests "value" defaultSeeds value2++value2DSparseTests :: [TestTree]+value2DSparseTests = golden2DSparseTests "value" defaultSeeds value2++value3DGridTests :: [TestTree]+value3DGridTests = golden3DImageTests "value" defaultSeeds value3++value3DSparseTests :: [TestTree]+value3DSparseTests = golden3DSparseTests "value" defaultSeeds value3