Tối ưu hóa Perlin tiếng ồn trong Haskell

Question

(Dependencies cho chương trình này. vector --any và JuicyPixels >= 2 Mã có sẵn như là 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 

Tôi cố gắng để cảng Ken Perlin's improved noise để Haskell, nhưng tôi không hoàn toàn chắc chắn rằng tôi phương pháp là chính xác. Phần chính là cái gì đó nên khái quát hóa độc đáo để kích thước cao hơn và thấp hơn, nhưng đó là một cái gì đó cho sau này:

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

Đây là khóa học kèm theo một vài chức năng được đề cập trong chức năng perlin3 , trong đó tôi hy vọng họ như hiệu quả càng tốt:

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 

Đối với nhóm hoán vị, tôi chỉ sao chép một Perlin sử dụng trên trang web của mình:

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) 

Và tất cả điều này được gắn cùng với 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) 

Vấn đề của tôi là perlin3 có vẻ rất chậm đối với tôi. Nếu tôi tiểu sử, pixelRenderer cũng sẽ mất nhiều thời gian, nhưng tôi sẽ bỏ qua điều đó ngay bây giờ. Tôi không biết cách tối ưu hóa perlin3. Tôi đã cố gắng gợi ý GHC với các mẫu hình chữ nhật, giúp cắt giảm thời gian thực hiện trong một nửa, vì vậy điều đó thật tuyệt. Chuyên sâu và nội tuyến rõ ràng hầu như không giúp được với ghc -O. Có phải perlin3 được cho là chậm không?

---

CẬP NHẬT: một phiên bản trước đó của câu hỏi này đề cập đến một lỗi trong mã của tôi. Vấn đề này đã được giải quyết; hóa ra phiên bản cũ của tôi là actuallyProperFraction là lỗi. Nó ngầm làm tròn phần không tách rời của một số dấu phẩy động thành Word8, và sau đó trừ nó khỏi số dấu phẩy động để lấy phần phân số. Vì Word8 chỉ có thể lấy các giá trị giữa 0 và 255, tính năng này sẽ không hoạt động chính xác cho các số nằm ngoài phạm vi đó, bao gồm cả số âm.

Answer 1

Mã này dường như hầu như được tính toán. Nó có thể được cải thiện một chút, nhưng không nhiều, trừ khi có một cách để sử dụng ít tra cứu mảng hơn và số học ít hơn.

Có hai công cụ hữu ích để đo lường hiệu suất: lược tả và kết xuất mã. Tôi đã thêm chú thích SCC vào perlin3 để chú thích hiển thị trong tiểu sử. Sau đó, tôi biên soạn với gcc -O2 -fforce-recomp -ddump-simpl -prof -auto. Cờ -ddump-simpl in mã được đơn giản hóa.

Hồ sơ: Trên máy tính, phải mất 0,60 giây để chạy chương trình và khoảng 20% ​​thời gian thực hiện (0,12 giây) được chi tiêu theo perlin3 theo cấu hình. Lưu ý rằng độ chính xác của thông tin tiểu sử của tôi là khoảng +/- 3%.

Đầu ra bộ khuếch đại: Bộ khuếch đại tạo ra mã khá rõ ràng. perlin3 được inline thành pixelRenderer, vì vậy đó là một phần của đầu ra bạn muốn xem.Hầu hết các mã bao gồm đọc unboxed mảng và số học unboxed. Để cải thiện hiệu suất, chúng tôi muốn loại bỏ một số số học này.

Thay đổi dễ dàng là loại bỏ kiểm tra thời gian chạy trên SomeFraction (không xuất hiện trong câu hỏi của bạn, nhưng là một phần của mã mà bạn đã tải lên). Điều này làm giảm thời gian thực hiện của chương trình xuống 0,56 giây.

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

Tiếp theo, có một số tra cứu mảng hiển thị trong simplifier như thế này:

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

Các hoạt động nguyên thủy narrow8Word# là cưỡng chế từ một Int đến một Word8. Chúng tôi có thể loại bỏ sự ép buộc này bằng cách sử dụng Int thay vì Word8 trong định nghĩa của next.

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

Điều này làm giảm thời gian thực hiện của chương trình xuống 0,54 giây. Chỉ xem xét thời gian dành cho perlin3, thời gian thực hiện đã giảm (khoảng) từ 0,12 đến 0,06 giây. Mặc dù rất khó để đo lường thời gian còn lại của thời gian, nó có khả năng lan rộng trong số các truy cập số học và mảng còn lại.

Answer 2

Trên mã tham chiếu máy của tôi với các tối ưu hóa của Heatsink mất 0,19 giây.

Đầu tiên, tôi đã chuyển JuicyPixels-yarr và yarr-image-io với cờ yêu thích của tôi, -Odph -rtsopts -threaded -fno-liberate-case -funbox-strict-fields -fexpose-all-unfoldings -funfolding-keeness-factor1000 -fsimpl-tick-factor=500 -fllvm -optlo-O3 (chúng được đưa ra here):

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) 

Điều này làm cho các chương trình nhanh hơn 30%, 0,13 giây.

Thứ hai tôi đã thay thế sử dụng theo tiêu chuẩn floor với

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

Được biết vấn đề (google "hiệu suất sàn Haskell"). Thời gian thực hiện được giảm xuống còn 52 ms (0,052 giây), trong gần 3 lần.

Cuối cùng, chỉ để cho vui, tôi đã cố gắng tính toán nhiễu song song (dComputeP thay vì dComputeS và +RTS -N4 trong dòng lệnh chạy). Chương trình mất 36 ms, bao gồm hằng số I/O khoảng 10 ms.