Haskell Binary Thresholding

BinaryThresholding.hs

{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes #-}

import Data.Word
import System.Environment
import Data.Array.Repa hiding ((++))
import Data.Array.Repa.IO.DevIL

main = do
    [input, output] <- getArgs

    runIL $ do
        inputImage <- readImage input 
        let greyscaleImage = traverse (imageArray inputImage) threeDtoTwoD luminosity
        let threshold = round $ fromIntegral $ findThreshold initialThreshold $ word8ToFloat $ toList greyscaleImage
        let binaryImage = computeS $ traverse greyscaleImage id (toBinary threshold)
        writeImage output (Grey(binaryImage))


{- Constants -}
black = 0
white = 255
initialThreshold = 80

{- Utility Functions -}
{-# INLINE imageArray #-}
imageArray (RGB arr) = arr

{- Functions for grayscaling step -}

{-# INLINE luminosity #-}
luminosity :: (DIM3 -> Word8) -> DIM2 -> Word8 
luminosity f (Z :. i :. j) = ceiling $ 0.3 * r + 0.59 * g + 0.11 * b
    where 
        r = fromIntegral $ f (Z :. i :. j :. 0)
        g = fromIntegral $ f (Z :. i :. j :. 1)
        b = fromIntegral $ f (Z :. i :. j :. 2)

{-# INLINE threeDtoTwoD #-}
threeDtoTwoD (Z :. i :. j :. _) = (Z :. i :. j)

{- Functions for binary thresholding step -}

{-# INLINE word8ToFloat #-}
word8ToFloat :: [Word8] -> [Float]
word8ToFloat list = Prelude.map toFloat list
                    where toFloat v = fromIntegral (fromIntegral v :: Int) * 1.0

{-# INLINE average #-}
average :: [Float] -> Float
average a = (sum a) / fromIntegral (length a)

{-# NOINLINE findThreshold #-}
findThreshold :: (Integral a) => a -> [Float] -> a
findThreshold threshold list
    | threshold' == threshold = threshold'
    | otherwise = findThreshold threshold' list
    where threshold' = round $ ((average (filter (> fromIntegral threshold) list)) + (average (filter (<= fromIntegral threshold) list))) / 2

{-# INLINE toBinary #-}
toBinary :: Word8 -> (DIM2 -> Word8) -> DIM2 -> Word8
toBinary threshold f (Z :. i :. j) 
    | value >= threshold = 255
    | otherwise = 0
    where value = fromIntegral $ f (Z :. i :. j)