`Friday` package is very slow

Question

I am writing a Haskell program that draws large maps from Knytt Stories . I use the friday package to create image files, and I need to compose a lot of graphic layers that I compiled from sprites. Right now, I'm using my own ugly function for this:

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

This is just an alpha composition of the bottom layer and the top layer, for example:

If the “bottom” layer is a texture, it will loop horizontally and vertically (on wrap ) to fit the size of the top layer.

---

Rendering a map takes much longer than necessary. Rendering a map for the default world that ships with the game takes 27 minutes in -O3 , although the game itself can clearly display every single screen in less than a couple of milliseconds. (The smaller output example linked above, see above, takes 67 seconds, also too long.)

The profiler (conclusion here ) says that the program spends about 77% of its time in compose .

Reducing this seems like a good first step. This seems like a very simple operation, but I cannot find a built-in function in friday that allows me to do this. Presumably, the GHC should be well versed in all fromFunction materials, but I don't know what is going on. Or is the package just super slow?

Get the full, compiled code.

Answer 1

As I said in my comment, I did MCE perfectly and does not provide any interesting output:

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

This code downloads two images, applies your layout operation and saves the resulting image. This happens almost instantly:

 % 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 

If you have an alternative MCE, send it. Your complete code was not too minimal for my eyes.