Question

问题

我编写了一个Haskell程序，它通过一个文件夹找到文件夹中每个图像的平均颜色。它使用来自hackage的repa-devil包将图像加载到修复阵列中。我通过添加所有红色，蓝色和绿色值然后除以像素数来找到平均值：

-- compiled with -O2
import qualified Data.Array.Repa as R
import Data.Array.Repa.IO.DevIL
import Control.Monad.Trans (liftIO)
import System.Directory (getDirectoryContents)

size :: (R.Source r e) => R.Array r R.DIM3 e -> (Int, Int)
size img = (w, h)
    where (R.Z R.:. h R.:. w R.:. 3) = R.extent img

averageColour :: (R.Source r e, Num e, Integral e) => R.Array r R.DIM3 e -> (Int, Int, Int)
averageColour img = (r `div` n, g `div` n, b `div` n)
    where (w, h)  = size img
          n       = w * h
          (r,g,b) = f 0 0 0 0 0
          f row col r g b
            | row >= w  = f 0 (col + 1) r g b
            | col >= h  = (r, g, b)
            | otherwise = f (row + 1) col (addCol 0 r) (addCol 1 g) (addCol 2 b)
            where addCol x v = v + fromIntegral (img R.! (R.Z R.:. col R.:. row R.:. x))

main :: IO ()
main = do
    files <- fmap (map ("images/olympics_backup/" ++) . filter (`notElem` ["..", "."])) $ getDirectoryContents "images/olympics_backup"
    runIL $ do
        images <- mapM readImage files
        let average = zip (map (\(RGB img) -> averageColour img) images) files
        liftIO . print $ average

我还使用Python Image Library在Python中编写了这个程序。它以相同的方式找到图像的平均值：

import Image

def get_images(folder):
    images = []
    for filename in os.listdir(folder):
        images.append(folder + filename)
    return images

def get_average(filename):
    image = Image.open(filename)
    pixels = image.load()
    r = g = b = 0
    for x in xrange(0, image.size[0]):
        for y in xrange(0, image.size[1]):
            colour = pixels[x, y]
            r += colour[0]
            g += colour[1]
            b += colour[2]
    area = image.size[0] * image.size[1]
    r /= area
    g /= area
    b /= area
    return [(r, g, b), filename, image]

def get_colours(images):
    colours = []
    for image in images:
        try:
            colours.append(get_average(image))
        except:
            continue
    return colours

imgs = get_images('images/olympics_backup/')
print get_colours(imgs)

当这两个图像都在包含301张图像的文件夹上运行时，Haskell版本的性能优于0.2秒（0.87对0.64）。这看起来很奇怪，因为Haskell是一种编译语言（通常比解释的语言更快），我听说修复数组具有良好的性能（尽管这可能与其他Haskell数据类型相比，如列表）。

我尝试了什么

我做的第一件事是注意我使用了显式递归，因此我决定使用折叠替换它，这也意味着我不再需要检查我是否超出了数组的范围：

(r,g,b) = foldl' f (0,0,0) [(x, y) | x <- [0..w-1], y <- [0..h-1]]
f (r,g,b) (row,col) = (addCol 0 r, addCol 1 g, addCol 2 b)
        where addCol x v = v + fromIntegral (img R.! (R.Z R.:. col R.:. row R.:. x))

这使得它运行得更慢（1.2秒）所以我决定分析代码并查看大部分时间花在哪里（如果我已经创建了一个明显的瓶颈或者者rep-devil包只是很慢）。该配置文件告诉我，大约58％的时间花在了f函数上，大约35％的时间花在了addCol上。

不幸的是，我想不出有什么方法可以让它跑得更快。该函数只是一个数组索引和一个附加项 - 与python代码相同。有没有办法提高此代码的性能，或者Python Image Library是否提供更高的性能？

Answer 1

虽然下面的代码是hackish，但速度非常快。

在0.03毫秒（16个抽头/像素）中获得75x75图像=＆gt;约。 300张图像10-20毫秒
512毫秒（Lenna），1毫秒（13.5张/像素）
2560x1600 in 12 ms（9.2 tics / pixel）

yarr专门用于解决像你这样的任务，不幸的是有一些问题（在代码注释中指出）不允许同时使代码真正简洁和快速。

一个像素例程是3个内存读取+ 3个add s，因此我大致期望3个tics /像素作为此任务的限制。

您还可以使用parallel-io包中的parallel轻松并行计算。

{-# LANGUAGE FlexibleContexts, TypeFamilies #-}

import System.Environment

import Data.Yarr
import Data.Yarr.IO.Image
import Data.Yarr.Walk
import Data.Yarr.Utils.FixedVector as V
import Data.Yarr.Shape as S

main :: IO ()
main = do
    [file] <- getArgs
    print =<< getAverage file

getAverage :: FilePath -> IO (Int, Int, Int)
getAverage file = do
    -- Meaningful choice, for homogenious images,
    -- in preference to readRGB(Vectors).
    -- readRGB make the case of representation -> polymorfic access ->
    -- poor performance 
    (RGB imageArr) <- readImage file
    -- let imageArr = readRGBVectors file
    let ext = extent imageArr
    avs <- averageColour imageArr
    return $ V.inspect avs (Fun (,,))


averageColour
    :: (Vector v Int, Dim v ~ N3, Integral e,
        UVecSource r slr l Dim2 v e, PreferredWorkIndex l Dim2 i)
    => UArray r l Dim2 (v e) -> IO (VecList N3 Int)
{-# INLINE averageColour #-}
averageColour image = fmap (V.map (`div` (w * h))) compSums
  where -- `walk (reduce ... (V.zipWith (+))) (return V.zero) image`
        -- would be more idiomatic and theoretically faster,
        -- but had problems with perf too :(
        compSums = walkSlicesSeparate sum (return 0) image
        -- would better to `mapElems fromIntegral imageArr` before counting,
        -- but faced some performance problems and I have no time to dig them
        {-# INLINE sum #-}
        sum = reduceL sumFold (\x y -> x + (fromIntegral y))
        sumFold = S.unrolledFoldl n8 noTouch
        (w, h) = extent image

编译

ghc-7.6.1 --make -Odph -rtsopts -threaded -fno-liberate-case -funbox-strict-fields -funfolding-keeness-factor1000 -fllvm -optlo-O3 -fexpose-all-unfoldings -fsimpl-tick-factor=500 -o avc average-color.hs

使用REPA优化haskell中的平均图像颜色程序

问题

我尝试了什么

1 个答案: