2013-03-22 12 views
6
でパーリンノイズ

最適化(このプログラムの依存関係:。。vector --anyJuicyPixels >= 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 

私はHaskellのにポートKen Perlin's improved noise にしようとしたが、私はその完全にわからないんだけど方法は正しいです。主要部分 は上位と下位次元にうまく一般化するべきものであるが、後のために何かある :

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 

置換群については、私はちょうど1パーリンは、彼のウェブサイト上で使用されるコピー:

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はこれが遅いと思われますか?


UPDATE:この質問の以前のバージョンは、私のコードのバグを述べました。この問題は解決されました。 actuallyProperFractionの古いバージョンがバグだったことが判明しました。それは暗黙的に浮動小数点数の整数部分をWord8に丸めた後、小数部を得るために浮動小数点数から減算したものです。 Word8は、0255の間の値しか取ることができないため、負数など、その範囲外の数値に対しては正しく動作しません。

+0

どのようにそれをプロファイリングしていますか? '-auto-all'でプロファイリングすると、プロファイルをより正確にする最適化が無効になります。私は '-auto-all'を使って' -auto'に比べて2.5倍の減速率を得ています。 – Heatsink

+0

私が持っていた 'GHC -O -oを/ tmp/IPerlin -prof -rtsopts -auto-すべて-caf-すべて-fforce-recomp IPerlin.lhs'、その後、'としてそれを呼び出すことを/ tmp/IPerlin + RTS -p -RTS/tmp/output.png'。 '-auto'は確かにはるかに速いですが、プロファイリングレポートにはほとんど情報が含まれていません(' perlin3'の言及なし)。また、私はほとんど私が探してすべきかを知っていない:P –

+0

私は 'grad'がvks''に異なるタイプを使用することによって改善することができると思います。タプルの 'Unbox'インスタンスは実際にそれらを配列のタプルとして保存します。トリプルタイプを作成し、その値を連続して格納するunboxインスタンスを作成すると、それが改善されるはずです。トリプル厳密にすることで、他のコードを単純化することもできます。 –

答えて

4

このコードは、ほとんどが計算上のバインディングのようです。これは少し改善することができますが、少ない数の配列検索を使用して算術を少なくする方法がない限りはあまり効果がありません。

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

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

簡略化出力:簡略化はかなりクリーンなコードを生成します。 perlin3pixelRendererにインライン化されているので、これは見たい出力の一部です。コードの大部分は、ボックス化されていない配列の読み込みとボックス化されていない演算で構成されています。パフォーマンスを向上させるために、この算術の一部を削除したいと考えています。

簡単な変更は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#Word8Intから強制するためのものです。私たちは、nextの定義にInt代わりのWord8を使用して、この強制を取り除くことができます。

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

これにより、プログラムの実行時間が0.54秒に短縮されます。 perlin3で費やされた時間だけを考えると、実行時間は(おおよそ)0.12秒から0.06秒になりました。時間の残りの部分がどこにあるかを測定することは難しいですが、残りの算術演算と配列アクセスの間で広がっている可能性が最も高いです。ヒートシンクの最適化と私のマシンリファレンスコードに

+0

だから、 'grad' /' dot3'や置換関数の最適化に焦点を合わせるべきだと思います。 :) 'someFraction'ランタイムチェックは、特定の値についての私の仮定が(おそらく)正しかったかどうかを確認するだけで、実動コードで実際に検査を削除する必要がありました。私は明日それをさらに見るでしょう。 –

2

は0.19秒かかります。

まず、私は(彼らはhereを与えられている)、私の好きなフラグとyarryarr-image-ioJuicyPixelsから-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秒になります。

は、第二に、私はそれが問題( "Haskellのフロア性能を" グーグル)が知られている

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

と標準floorの使用を交換しました。実行時間は52ms(0.052秒)に短縮され、ほぼ3倍になります。

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

+0

これはPerlinノイズ関数自体を最適化するものではありませんが、合計実行時間を大幅に削減します。 'floor 'をそれ自体で置き換えることは、すでに大きなパフォーマンス向上(4 Mipx画像で5.42秒から2.40秒まで)です。私は 'yarr-image-io'に移行したいのかどうか分かりません(Devilを使い始めるとWindowsのパッケージ化がどれほど難しくなるのか分かりませんが)。ヒントをありがとう、あなたの図書館を披露してくれてありがとう! :) –

+0

@Rhymoidは、 'fixed-vector'ライブラリからの制御フローでx-y-zボイラープレートを置き換えることも考えます。例、 'dot3 = sum。 zipWith(*) '(__(http://hackage.haskell.org/packages/archive/fixed-vector/0.1.2.1/doc/html/Data-Vector-Fixed.html#v:sum)、[ zipWith](http://hackage.haskell.org/packages/archive/fixed-vector/0.1.2.1/doc/html/Data-Vector-Fixed.html#v:zipWith)) – leventov