(此程序的依赖项：vector –any和JuicyPixels> = 2.代码可用作 Gist.) @H_301_2@{-# LANGUAGE Haskell2010 #-} {-# LANGUAGE BangPatterns #-} import Control.Arrow import Data.Bits import Data.Vector.UnBoxed ((!)) import Data.Word import System.Environment (getArgs) import qualified Codec.Picture as P import qualified Data.ByteString as B import qualified Data.Vector.UnBoxed as V

我试着移植Ken Perlin’s improved noise
到Haskell,但我不完全确定我的方法是正确的.主要部分
是一个应该很好地推广到更高和更低维度的东西,但是
这是以后的事情：

@H_301_2@perlin3 :: (Ord a,Num a,RealFrac a,V.UnBox a) => Permutation -> (a,a,a) -> a perlin3 p (!x',!y',!z') = let (!xX,!x) = actuallyProperFraction x' (!yY,!y) = actuallyProperFraction y' (!zZ,!z) = actuallyProperFraction z' !u = fade x !v = fade y !w = fade z !h = xX !a = next p h + yY !b = next p (h+1) + yY !aa = next p a + zZ !ab = next p (a+1) + zZ !ba = next p b + zZ !bb = next p (b+1) + zZ !aaa = next p aa !aab = next p (aa+1) !aba = next p ab !abb = next p (ab+1) !baa = next p ba !bab = next p (ba+1) !bba = next p bb !bbb = next p (bb+1) in lerp w (lerp v (lerp u (grad aaa (x,y,z)) (grad baa (x-1,z))) (lerp u (grad aba (x,y-1,z)) (grad bba (x-1,z)))) (lerp v (lerp u (grad aab (x,z-1)) (grad bab (x-1,z-1))) (lerp u (grad abb (x,z-1)) (grad bbb (x-1,z-1))))

这当然伴随着perlin3中提到的一些功能
功能,我希望它们尽可能高效：

@H_301_2@fade :: (Ord a,Num a) => a -> a fade !t | 0 <= t,t <= 1 = t * t * t * (t * (t * 6 - 15) + 10) lerp :: (Ord a,Num a) => a -> a -> a -> a lerp !t !a !b | 0 <= t,t <= 1 = a + t * (b - a) grad :: (Bits hash,Integral hash,V.UnBox a) => hash -> (a,a) -> a grad !hash (!x,!y,!z) = dot3 (vks `V.unsafeIndex` fromIntegral (hash .&. 15)) (x,z) where vks = V.fromList [ (1,1,0),(-1,(1,-1,1),-1),(0,-1) ] dot3 :: Num a => (a,a) -> (a,a) -> a dot3 (!x0,!y0,!z0) (!x1,!y1,!z1) = x0 * x1 + y0 * y1 + z0 * z1 -- Unlike `properFraction`,`actuallyProperFraction` rounds as intended. actuallyProperFraction :: (RealFrac a,Integral b) => a -> (b,a) actuallyProperFraction x = let (ipart,fpart) = properFraction x r = if x >= 0 then (ipart,fpart) else (ipart-1,1+fpart) in r

对于排列组,我只是复制了他网站上使用的Perlin：

@H_301_2@newtype Permutation = Permutation (V.Vector Word8) mkPermutation :: [Word8] -> Permutation mkPermutation xs | length xs >= 256 = Permutation . V.fromList $xs permutation :: Permutation permutation = mkPermutation [151,160,137,91,90,15,131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,240,21,10,23,190,6,148,247,120,234,75,26,197,62,94,252,219,203,117,35,11,32,57,177,33,88,237,149,56,87,174,20,125,136,171,168,68,175,74,165,71,134,139,48,27,166,77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46,245,40,244,102,143,54,65,25,63,161,216,80,73,209,76,132,187,208,89,18,169,200,196,135,130,116,188,159,86,164,100,109,198,173,186,3,64,52,217,226,250,124,123,5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,182,189,28,42,223,183,170,213,119,248,152,2,44,154,163,70,221,153,101,155,167,43,172,9,129,22,39,253,19,98,108,110,79,113,224,232,178,185,112,104,218,246,97,228,251,34,242,193,238,210,144,12,191,179,162,241,81,51,145,235,249,14,239,107,49,192,214,31,181,199,106,157,184,84,204,176,115,121,50,45,127,4,150,254,138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,180 ] next :: Permutation -> Word8 -> Word8 next (Permutation !v) !idx' = v `V.unsafeIndex` (fromIntegral $idx' .&. 0xFF)

所有这些都与JuicyPixels捆绑在一起：

@H_301_2@main = do [target] <- getArgs let image = P.generateImage pixelRenderer 512 512 P.writePng target image where pixelRenderer,pixelRenderer' :: Int -> Int -> Word8 pixelRenderer !x !y = floor $((perlin3 permutation ((fromIntegral x - 256) / 32,(fromIntegral y - 256) / 32,0 :: Double))+1)/2 * 128 -- This code is much more readable,but also much slower. pixelRenderer' x y = (\w -> floor $((w+1)/2 * 128)) -- w should be in [-1,+1] . perlin3 permutation . (\(x,z) -> ((x-256)/32,(y-256)/32,(z-256)/32)) $(fromIntegral x,fromIntegral y,0 :: Double)

我的问题是perlin3对我来说似乎很慢.如果我对它进行配置,则为pixelRenderer
也有很多时间,但我现在会忽略它.我不知道
如何优化perlin3.我试图暗示GHC的爆炸模式,削减
执行时间减半,这样很好.明确专业化和内联
ghc -O几乎没有帮助. perlin3应该是这么慢吗？

更新：此问题的早期版本提到了我的代码中的错误.这个问题已经解决了;事实证明我的旧版本的ActualProperFraction是错误的.它隐含地将浮点数的整数部分舍入到Word8,然后从浮点数中减去它以得到小数部分.由于Word8只能取0到255之间的值,因此对于该范围之外的数字(包括负数),这将无法正常工作.