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

Question

问题

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

-- 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 图像库用 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 是一种编译语言(通常比解释型语言更快)，而且我听说 repa 数组具有良好的性能(尽管这可能只是与其他 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 秒)，所以我决定分析代码并查看大部分时间花在哪里(以防我造成了明显的瓶颈或 repa-devil 包太慢了)。配置文件告诉我，约 58% 的时间花在 f 函数上，约 35% 的时间花在 addCol 上。

不幸的是，我想不出有什么方法可以使它运行得更快。该函数只是一个数组索引和一个加法——与 python 代码相同。有没有办法提高此代码的性能，或者 Python 图像库只是提供更高的性能？

Answer 1

虽然下面的代码有点乱，但速度还是很快的。

• 在 0.03 毫秒内处理 75x75 图像(16 次抽动/像素)=> 大约。 300 张图像 10-20 毫秒

• 512x512 (Lenna)，1 毫秒(13.5 次抽动/像素)

• 12 毫秒内的 2560x1600(9.2 次控制/像素)

yarr 是专门为解决像您这样的任务而设计的，不幸的是有一些问题(在代码注释中指出)不允许同时使代码真正简洁和快速。

一个像素例程是 3 次内存读取 + 3 次添加，所以我粗略地预计 3 个 tic/pixel 作为此任务的限制。

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

{-# 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