`friday` 软件包非常慢

Question

我正在编写一个Haskell程序，从Knytt Stories世界文件中绘制大地图。我使用friday包来生成图像文件，并需要组合从精灵表中汇总的许多图形层。目前，我使用自己的丑陋函数来完成这个任务：

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

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

如果“底部”层是一种纹理，它将通过wrap水平和垂直循环以适应顶部层的大小。

---

渲染地图所需时间远远超过应有的时间。对于默认世界的地图，在-O3下需要花费27分钟，尽管游戏本身明显可以在不到几毫秒的时间内呈现每个单独的屏幕。(上面链接的较小示例输出需要67秒，也太长了。)

分析器(输出在此)显示程序大约77%的时间都花费在compose上。

将其削减似乎是一个良好的第一步。这似乎是一个非常简单的操作，但我找不到friday中允许我这样做的本地函数。据说GHC应该擅长折叠所有的fromFunction东西，但我不知道发生了什么。或者这个包只是超级慢吗？ 这里是完整的可编译代码。

- Lynn

---

“*” 操作两个单词，应该快速且不进行任何分配。但是，性能分析表明这并非如此，至少有些可疑。可能是由于 Im.fromFunction 构建了 “*” 和其他函数的惰性求值。此外，测试方式可能会影响性能，该库可能在融合和摊销成本分析方面依赖很大，但这可能会被打破。 - user2407038

从 RGBA 切换到 RGBADelayed 可能会有很大的改善。你能用言语解释一下 compose 应该计算什么吗？这并不是世界上最显而易见的事情。 - dfeuer

另外，使用 floor 而不是 round。 - Thomas M. DuBuisson

我已经用“千言万语”解释了一下 :) 有机会我会尝试使用RGBADelayed，谢谢。 - Lynn

wrap 也相当慢。您可以使用 fromFunctionCached 来执行每行仅一个整数除法和每列仅一个整数除法，而不是每个像素两个整数除法。 - dfeuer

Answer 1

正如我在评论中所述，我制作的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

这段代码加载了两张图片，应用了您的组合操作，并保存了结果图像。这个过程几乎瞬间完成：

% 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

如果您有其他的MCE，请发帖分享。您的完整代码对我来说过于冗长。

- Thomas M. DuBuisson

---

嗯，我相信合成两张图片不需要很长时间。问题是合成成千上万张图片不应该花费这么长时间。 - Lynn

我再问一遍 - 能提供一个最小可编译示例吗？ - Thomas M. DuBuisson