Optimizing Perlin Geräusch in Haskell

Question

(Abhängigkeiten für dieses Programm. vector --any und JuicyPixels >= 2 ist Kodex Gist verfügbar.)

{-# 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 

ich zu portieren versucht Ken Perlin's improved noise zu Haskell, aber ich bin nicht ganz sicher, dass mein Methode ist richtig. Der Hauptteil ist etwas, das schön zu höheren und niedrigeren Dimensionen verallgemeinern sollte, aber , die etwas für später ist:

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)))) 

Das ist natürlich durch einige Funktionen in der Funktion perlin3 erwähnt begleitet, von denen ich nur kopiert

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 

Für die Permutation Gruppe, ich derjenige Perlin auf seiner Website verwendet: hoffen, sie so effizient wie möglich sind

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) 

Und all dies ist gebunden zusammen mit 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) 

Mein Problem ist, dass perlin3 mir sehr langsam zu sein scheint. Wenn ich es profiliere, wird pixelRenderer eine Menge Zeit auch, aber ich werde das für jetzt ignorieren. Ich weiß nicht wie zu optimieren perlin3. Ich habe versucht, GHC mit Knallmustern anzudeuten, was die Ausführungszeit in zwei Hälften schneidet, also ist das nett. Explizit spezialisiert und inlining hilft kaum mit ghc -O. Ist perlin3 angeblich so langsam?

---

UPDATE: eine frühere Version dieser Frage erwähnt einen Fehler in meinem Code. Dieses Problem wurde behoben. Es stellt sich heraus, dass meine alte Version actuallyProperFraction fehlerhaft war. Implizit wurde der ganzzahlige Teil einer Gleitkommazahl auf Word8 gerundet und dann von der Gleitkommazahl subtrahiert, um den Bruchteil zu erhalten. Da Word8 nur Werte zwischen 0 und 255 einschließlich annehmen kann, funktioniert dies nicht ordnungsgemäß für Zahlen außerhalb dieses Bereichs, einschließlich negativer Zahlen.

Answer 1

Dieser Code scheint hauptsächlich rechnergebunden zu sein. Es kann ein wenig verbessert werden, aber nicht viel, es sei denn, es gibt eine Möglichkeit, weniger Array-Lookups und weniger Arithmetik zu verwenden.

Es gibt zwei nützliche Tools zum Messen der Leistung: Profiling und Codedumps. Ich fügte perlin3 eine SCC-Anmerkung hinzu, so dass sie im Profil angezeigt würde. Dann habe ich mit gcc -O2 -fforce-recomp -ddump-simpl -prof -auto kompiliert. Das Flag -ddump-simpl druckt den vereinfachten Code.

Profilierung: Auf meinem Computer, dauert es 0,60 Sekunden um das Programm auszuführen, und etwa 20% der Ausführungszeit (0,12 Sekunden), wird in perlin3 entsprechend das Profil verbracht. Beachten Sie, dass die Genauigkeit meiner Profilinformationen ungefähr +/- 3% beträgt.

Simplifier-Ausgabe: Der Simplifier erzeugt ziemlich sauberen Code. perlin3 wird in pixelRenderer inline, so dass der Teil der Ausgabe ist, die Sie betrachten möchten.Der größte Teil des Codes besteht aus ungeboxten Array-Lesevorgängen und ungekosten Arithmetik. Um die Leistung zu verbessern, möchten wir einige dieser Arithmetik eliminieren.

Eine einfache Änderung besteht darin, die Laufzeitprüfungen an SomeFraction zu entfernen (die nicht in Ihrer Frage angezeigt wird, aber Teil des von Ihnen hochgeladenen Codes ist). Dies reduziert die Ausführungszeit des Programms auf 0,56 Sekunden.

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

Als nächstes gibt es mehrere Array-Lookups, die wie folgt in dem Vereinfacher zeigen:

    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)))) 

Die primitive Operation narrow8Word# für von einem Int zu einem Word8 Nötigung ist. Wir können diesen Zwang unter Verwendung von Int anstelle von Word8 in der Definition von next loswerden.

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

Dies reduziert die Ausführungszeit des Programms auf 0,54 Sekunden. Betrachtet man nur die Zeit, die in perlin3 verbracht wurde, ist die Ausführungszeit (ungefähr) von 0,12 auf 0,06 Sekunden gefallen. Obwohl es schwer ist zu messen, wo der Rest der Zeit läuft, ist es am wahrscheinlichsten unter den verbleibenden Arithmetik- und Array-Zugriffen verteilt.

Answer 2

Auf meinem Computer Referenzcode mit Heatsink-Optimierungen dauert 0,19 Sekunden.

Erstens ich JuicyPixels-yarr und yarr-image-io mit meinen Lieblingsflaggen bewegt habe, -Odph -rtsopts -threaded -fno-liberate-case -funbox-strict-fields -fexpose-all-unfoldings -funfolding-keeness-factor1000 -fsimpl-tick-factor=500 -fllvm -optlo-O3 (sie sind here angegeben):

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) 

Das macht das Programm 30% schneller, 0,13 Sekunden.

Zweitens habe ich Gebrauch von Standard-floor mit

Ausgabe

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

Es ist bekannt, ersetzt (google "Haskell Boden Leistung"). Die Ausführungszeit wird auf fast 50 ms (0,052 Sekunden) reduziert.

Schließlich habe ich nur zum Spaß versucht, Rauschen parallel zu berechnen (dComputeP statt dComputeS und +RTS -N4 in der Befehlszeile ausgeführt). Das Programm dauerte 36 ms, einschließlich der I/O-Konstante von etwa 10 ms.