Performance `星期五的包裹很慢

我正在写一个Haskell程序，它从世界文件中提取数据。我使用这个软件包来制作图像文件，并且我需要组成我从spritesheets组合起来的许多图形层。现在，我使用自己的丑陋函数来实现这一点：

import qualified Vision.Primitive as Im
import qualified Vision.Image.Type as Im
import qualified Vision.Image.Class as Im
import Vision.Image.RGBA.Type (RGBA, RGBAPixel(..))

-- Map a Word8 in [0, 255] to a Double in [0, 1].
w2f :: Word8 -> Double
w2f = (/255) . fromIntegral . fromEnum

-- Map a Double in [0, 1] to a Word8 in [0, 255].
f2w :: Double -> Word8
f2w = toEnum . round . (*255)

-- Compose two images into one. `bottom` is wrapped to `top`'s size.
compose :: RGBA -> RGBA -> RGBA
compose bottom top =
    let newSize = Im.manifestSize top
        bottom' = wrap newSize bottom
    in Im.fromFunction newSize $ \p ->
        let RGBAPixel rB gB bB aB = bottom' Im.! p
            RGBAPixel rT gT bT aT = top Im.! p
            aB' = w2f aB; aT' = w2f aT
            ovl :: Double -> Double -> Double
            ovl cB cT = (cT * aT' + cB * aB' * (1.0 - aT')) / (aT' + aB' * (1.0 - aT'))
            (~*~) :: Word8 -> Word8 -> Word8
            cB ~*~ cT = f2w $ w2f cB `ovl` w2f cT
            aO = f2w (aT' + aB' * (1.0 - aT'))
        in RGBAPixel (rB ~*~ rT) (gB ~*~ gT) (bB ~*~ bT) aO

它只是将底层和顶层合成，如下所示：

如果“底层”是一个纹理，它将水平和垂直循环（通过

包裹
）以适应顶层的大小


渲染贴图所需的时间远远超过它应该花费的时间。在
-O3
，为游戏附带的默认世界渲染地图需要27分钟，即使游戏本身可以在不到几毫秒的时间内清晰地渲染每个单独的屏幕。（上面我链接的较小示例输出需要67秒；也太长了。）

分析器（输出为）表示，程序大约77%的时间都花在编写
上

减少这个似乎是一个很好的第一步。这似乎是一个非常简单的操作，但我在
friday
中找不到一个本机函数来实现这一点。据推测，GHC应该擅长从Function
折叠所有的
，但我不知道发生了什么。还是包裹太慢了

如我在评论中所述，我制作的MCE性能良好，不会产生任何有趣的输出：

module Main where
import qualified Vision.Primitive as Im
import Vision.Primitive.Shape
import qualified Vision.Image.Type as Im
import qualified Vision.Image.Class as Im
import Vision.Image.RGBA.Type (RGBA, RGBAPixel(..))
import Vision.Image.Storage.DevIL (load, save, Autodetect(..), StorageError, StorageImage(..))
import Vision.Image (convert)
import Data.Word
import System.Environment (getArgs)

main :: IO ()
main = do
  [input1,input2,output] <- getArgs
  io1 <- load Autodetect input1 :: IO (Either StorageError StorageImage)
  io2 <- load Autodetect input2 :: IO (Either StorageError StorageImage)
  case (io1,io2) of
    (Left err,_) -> error $ show err
    (_,Left err) -> error $ show err
    (Right i1, Right i2) -> go (convert i1) (convert i2) output
 where
  go i1 i2 output =
      do res <- save Autodetect output (compose i1 i2)
         case res of
          Nothing -> putStrLn "Done with compose"
          Just e  -> error (show (e :: StorageError))

-- Wrap an image to a given size.
wrap :: Im.Size -> RGBA -> RGBA
wrap s im =
    let Z :. h :. w = Im.manifestSize im
    in Im.fromFunction s $ \(Z :. y :. x) -> im Im.! Im.ix2 (y `mod` h) (x `mod` w)

-- Map a Word8 in [0, 255] to a Double in [0, 1].
w2f :: Word8 -> Double
w2f = (/255) . fromIntegral . fromEnum

-- Map a Double in [0, 1] to a Word8 in [0, 255].
f2w :: Double -> Word8
f2w = toEnum . round . (*255)

-- Compose two images into one. `bottom` is wrapped to `top`'s size.
compose :: RGBA -> RGBA -> RGBA
compose bottom top =
    let newSize = Im.manifestSize top
        bottom' = wrap newSize bottom
    in Im.fromFunction newSize $ \p ->
        let RGBAPixel rB gB bB aB = bottom' Im.! p
            RGBAPixel rT gT bT aT = top Im.! p
            aB' = w2f aB; aT' = w2f aT
            ovl :: Double -> Double -> Double
            ovl cB cT = (cT * aT' + cB * aB' * (1.0 - aT')) / (aT' + aB' * (1.0 - aT'))
            (~*~) :: Word8 -> Word8 -> Word8
            cB ~*~ cT = f2w $ w2f cB `ovl` w2f cT
            aO = f2w (aT' + aB' * (1.0 - aT'))
        in RGBAPixel (rB ~*~ rT) (gB ~*~ gT) (bB ~*~ bT) aO

如果您有备用MCE，请将其发布。你的完整代码对我来说太不简单了。
~*~
用两个词操作，应该很快，不需要分配。档案显示情况并非如此，至少是可疑的。可能是
~*~
和其他函数的thunk正在由
Im.fromFunction
构建，不管是什么。此外，测试方法可能会对性能产生影响，该库可能严重依赖融合和摊销成本分析来获得良好的性能，但这可能会被打破。从
RGBA
切换到
RGBADelayed
可能会产生很大的不同。你能用文字解释一下
compose
应该计算什么吗？这不是世界上最明显的事情。另外，用地板代替圆形。我继续用“千言万语”解释说：）有机会时我会试试
RGBADelayed
，谢谢。
wrap
也很慢。您可以使用
fromFunctionCached
对每行和每列执行一个整数除法，而不是对每像素执行两个整数除法。问题是，编写数千个示例不需要这么长的时间，所以我再次询问-是否提供一个最小的可编译示例？
% ghc -O2 so.hs && time ./so /tmp/lambda.jpg /tmp/lambda2.jpg /tmp/output.jpg && o /tmp/output.jpg
Done with compose
./so /tmp/lambda.jpg /tmp/lambda2.jpg /tmp/output.jpg  0.05s user 0.00s system 98% cpu 0.050 total