6

(このプログラムの依存関係:vector --anyおよびJuicyPixels >= 2。コードはGistとして入手できます。)

{-# 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 の改善されたノイズを Haskellに移植しようとしまし たが、私の方法が正しいかどうかは完全にはわかりません。主要部分は、高次元と低次元にうまく一般化する必要があるものですが、それは後で説明します。

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, y, z)))
                (lerp u
                    (grad aba (x, y-1, z))
                    (grad bba (x-1, y-1, z))))
            (lerp v
                (lerp u
                    (grad aab (x, y, z-1))
                    (grad bab (x-1, y, z-1)))
                (lerp u
                    (grad abb (x, y-1, z-1))
                    (grad bbb (x-1, y-1, z-1))))

もちろん、これには関数で言及されているいくつかの関数が伴いperlin3 ますが、それらが可能な限り効率的であることを願っています。

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, Num a, V.Unbox a) => hash -> (a, a, a) -> a
grad !hash (!x, !y, !z) = dot3 (vks `V.unsafeIndex` fromIntegral (hash .&. 15)) (x, y, z)
  where
    vks = V.fromList
        [ (1,1,0), (-1,1,0), (1,-1,0), (-1,-1,0)
        , (1,0,1), (-1,0,1), (1,0,-1), (-1,0,-1)
        , (0,1,1), (0,-1,1), (0,1,-1), (0,-1,-1)
        , (1,1,0), (-1,1,0), (0,-1,1), (0,-1,-1)
        ]

dot3 :: Num a => (a, 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 が彼の Web サイトで使用したものをコピーしました。

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,0,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, 1,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 と結びついています:

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,y,z) -> ((x-256)/32, (y-256)/32, (z-256)/32))
        $ (fromIntegral x, fromIntegral y, 0 :: Double)

私の問題は、それが私perlin3には非常に遅いように見えることです。私pixelRenderer がそれをプロファイリングすると、同様に多くの時間がかかっていますが、今は無視します。最適化の仕方がわかりませんperlin3。強打パターンで GHC をほのめかそうとしましたが、これにより実行時間が半分になりました。明示的な特殊化とインライン化は、ほとんど役に立ちませんghc -O。これはperlin3遅いはずですか？

更新: この質問の以前のバージョンでは、コードのバグについて言及されていました。この問題は解決されました。私の古いバージョンのactuallyProperFractionはバグが多かったことがわかりました。浮動小数点数の整数部分を に暗黙的に丸め、それを浮動小数点数からWord8減算して小数部分を取得していました。とWord8の間の値しかとれないため、負の数を含むその範囲外の数値に対しては正しく機能しません。0255

4

2 に答える 2

4

このコードは、ほとんどが計算に縛られているようです。少しは改善できますが、使用する配列の検索と演算を減らす方法がない限り、それほど改善することはできません。

パフォーマンスを測定するには、プロファイリングとコード ダンプという 2 つの便利なツールがあります。perlin3プロファイルに表示されるように、SCC 注釈を追加しました。次に、でコンパイルしましgcc -O2 -fforce-recomp -ddump-simpl -prof -autoた。-ddump-simplフラグは簡略化されたコードを出力します。

プロファイリング:私のコンピューターでは、プログラムの実行に 0.60 秒かかり、実行時間の約 20% (0.12 秒) がperlin3プロファイルに従って費やされます。私のプロフィール情報の精度は約 +/-3% であることに注意してください。

Simplifier の出力: Simplifierはかなりきれいなコードを生成します。 perlin3にインライン化されるpixelRendererので、見たい出力の部分です。ほとんどのコードは、ボックス化されていない配列の読み取りとボックス化されていない算術演算で構成されています。パフォーマンスを向上させるために、この演算の一部を排除したいと考えています。

簡単な変更は、実行時チェックを削除することですSomeFraction(質問には表示されませんが、アップロードしたコードの一部です)。これにより、プログラムの実行時間が 0.56 秒に短縮されます。

-- someFraction t | 0 <= t, t < 1 = SomeFraction t
someFraction t = SomeFraction t

次に、次のように単純化ツールに表示される配列ルックアップがいくつかあります。

                 case GHC.Prim.indexWord8Array#
                        ipv3_s23a
                        (GHC.Prim.+#
                           ipv1_s21N
                           (GHC.Prim.word2Int#
                              (GHC.Prim.and#
                                 (GHC.Prim.narrow8Word#
                                    (GHC.Prim.plusWord# ipv5_s256 (__word 1)))
                                 (__word 255))))

プリミティブ操作narrow8Word#は、 からIntへの強制Word8です。の定義でInt代わりにを使用することで、この強制を取り除くことができます。Word8next

next :: Permutation -> Int -> Int
next (Permutation !v) !idx'
  = fromIntegral $ v `V.unsafeIndex` (fromIntegral idx' .&. 0xFF)

これにより、プログラムの実行時間が 0.54 秒に短縮されます。で費やされた時間だけを考慮するperlin3と、実行時間は (およそ) 0.12 秒から 0.06 秒に短縮されました。残りの時間がどこに行くのかを測定するのは困難ですが、残りの算術アクセスと配列アクセスに分散している可能性が最も高いです。

于 2013-03-22T18:49:55.733 に答える
2

ヒートシンクの最適化を使用したマシン参照コードでは、0.19 秒かかります。

まず、お気に入りのフラグJuicyPixelsから移動yarrしました(ここに表示されます):yarr-image-io-Odph -rtsopts -threaded -fno-liberate-case -funbox-strict-fields -fexpose-all-unfoldings -funfolding-keeness-factor1000 -fsimpl-tick-factor=500 -fllvm -optlo-O3

import Data.Yarr as Y
import Data.Yarr.IO.Image as Y
...

main = do
    [target] <- getArgs
    image <- dComputeS $ fromFunction (512, 512) (return . pixelRenderer)
    Y.writeImage target (Grey image)
  where
    pixelRenderer, pixelRenderer' :: Dim2 -> Word8
    pixelRenderer (y, x)
        = 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' (y, x)
        = (\w -> floor $ ((w+1)/2 * 128)) -- w should be in [-1,+1]
        . perlin3 permutation
        . (\(x,y,z) -> ((x-256)/32, (y-256)/32, (z-256)/32))
        $ (fromIntegral x, fromIntegral y, 0 :: Double)

これにより、プログラムは 30% 速くなり、0.13 秒になります。

次に、標準の使用を次のように置き換えましfloorた

doubleToByte :: Double -> Word8
doubleToByte f = fromIntegral (truncate f :: Int)

これは既知の問題です (google "haskell floor performance")。実行時間は、ほぼ 3 倍で 52 ミリ秒 (0.052 秒) に短縮されます。

最後に、ちょっとした楽しみとして、並列でノイズを計算しようとしました (コマンド ラインで実行するdComputeP代わりにdComputeS) 。+RTS -N4プログラムは、約 10 ms の I/O 定数を含めて 36 ms かかりました。

于 2013-03-23T09:58:39.953 に答える