4
\$\begingroup\$

I'm currently learning haskell, and I wanted a simple project to get started. This project uses the JuicyPixels package to handle image reading. The logic of the image to ascii art algorithm is quite simple:

  • quantize the image in a number of bins equal to the number of ASCII character we want to use
  • map each pixel to its ASCII counterpart.

The code is the following:

#!/usr/bin/env runhaskell

import Codec.Picture
import Data.Dynamic
import Data.Vector.Storable as V
import Data.Word
import Prelude as P

replacementChars :: [Char]
replacementChars = "#@&%=|;:. "

imageToAscii :: String -> Image Pixel8 -> [String]
imageToAscii mapChar img = chunksOf (imageWidth img) . toList $ V.map replaceByChar (imageData qImg)
  where
    qImg = quantizeImage (fromIntegral numBin) img
    replaceByChar p = mapChar !! fromIntegral p
    numBin = 1 + 255 `div` P.length mapChar

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = as : chunksOf n bs where (as, bs) = P.splitAt n xs

quantizeImage :: Word8 -> Image Pixel8 -> Image Pixel8
quantizeImage numBin = pixelMap (quantize numBin)

quantize :: Word8 -> Word8 -> Word8
quantize numBin x = x `div` numBin

rgbaToGray :: Image PixelRGBA8 -> Image Pixel8
rgbaToGray = pixelMap pixelAvg

-- contrast preserving for human vision RGB -> Gray is the following 0.2989 * R + 0.5870 * G + 0.1140 * B
pixelAvg :: PixelRGBA8 -> Pixel8
pixelAvg (PixelRGBA8 r g b a) = round $ 0.2989 * fromIntegral r + 0.5870 * fromIntegral g + 0.1140 * fromIntegral b

main :: IO ()
main = do
  img <- readImage "hamburger.png"
  case img of
    Left str -> print str
    Right img -> putStr $ unlines (imageToAscii replacementChars $ rgbaToGray (convertRGBA8 img))

An example of result on the hamburger emoji taken from Joypixel:

Hamburger emoji from joypixel

################################################################
################################################################
###########################          ###########################
######################                    ######################
###################                          ###################
################          .....::.....          ################
##############        ..::;;;;;;;;;;;;;:..        ##############
#############      .::;;;;;;;;;;;;;;;;;;;;::.      #############
###########      .:;;;;;;;;;;;;;;;;;;;;;;;;;;:.      ###########
##########     .:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:.     ##########
#########     :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:     #########
########    .:;;;;;;;;::;;;;;;;;;;;;;;;;::;;;;;;;;:.    ########
#######    .:;;;;;;;;;..;;;;;;;;;;;;;;;;..;;;;;;;;;:.    #######
######    .:;;;;;;;;;;::;;;;;;;::;;;;;;;::;;;;;;;;;;:.    ######
######   .:;;;;;;;;;;;;;;;;;;;;..;;;;;;;;;;;;;;;;;;;;:.   ######
#####    :;;;;;;;;;;;;;;;;;;;;;::;;;;;;;;;;;;;;;;;;;;;:    #####
#####   .;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;.   #####
####    :;;;;;;;::;;;;;;;;;;;;;;;;;;;;;;;;;;;;::;;;;;;;:    ####
####   .;;;;;;;;.:;;;;;;;;;;;;;;;;;;;;;;;;;;;;:.;;;;;;;;.   ####
####   :;;;;;;;;::;;;;;;;;;;;;;;;;;;;;;;;;;;;;::;;;;;;;;:   ####
####   :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:   ####
####   :;;;;;;;;;;;;;;;;;:::;;;;;;;;:::;;;;;;;;;;;;;;;;;:   ####
###   .;;;;;;;;;;;;;;;;;;:.:;;;;;;;;:.:;;;;;;;;;;;;;;;;;;.   ###
###   :;;;;;;;;;;;;;;;;;;;:;;;;;;;;;;:;;;;;;;;;;;;;;;;;;;:   ###
###   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:   ###
###   :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   ###
###   :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|:   ###
###   .|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|:   ###
###   .;|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;||;   ###
###   .||;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;||;   ###
###   .|=|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||;   ###
###   .;===|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||;   ###
###   .:=====|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||||:   ###
###   ::|======||;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||||||=:   ###
##   .;:;======|||||||;;;;;;;;;;;;;;;;;;;;|||||||||||||=|;.   ##
##   :|::|=====|||||||||||||||||||||||||||||||||||||||==:|:   ##
##   ;%:::=====|||||||||||||||||||||||||||||||||||||||=|:%;   ##
##   ;%|::;=======||||||||||||||||||||||||||||||||||||=:|%;   ##
##   ;%%;::;======||||||||||||||||||||||||||||||||||||:;%%;   ##
##   :%%%;::;=====|||||||||====;;||||||||||||||||||||:;%%%:   ##
##   .%%%%;:::|===|||||||====|;::|||||====|||||||||||;%%%%.   ##
###   |%%%%|::::;=||||||===|;::::;||||=======||||||||%%%%|   ###
###   .%%%%%=;:::::;;;;;;;::::::::;||;=========|;;||%%%%%.   ###
####   ;%%%%%%=;::::::::::::::::::::;:::;;;;;:::;=%%%%%%;   ####
####    =%%%%%%%%|:::::::::::::::::::::::::::;|%%%%%%%%=    ####
#####   ;=%%%%%%%%=;:::::::::::::::::::::;;|%%%%%%%%%%=;   #####
#####   :;=%%%%%%%%%;::::::::::::::::;|=%%%%%%%%%%%%%=;:   #####
#####   :;;|%%%%%%%%%;:::::::::::::;=%%%%%%%%%%%%%%%|;;:   #####
#####   .;;;;=%%%%%%%%;:::::::::::;%%%%%%%%%%%%%%%=;;;;.   #####
#####    :;;;;|=%%%%%%%;:::::::::;%%%%%%%%%%%%%%=|;;;;:    #####
######   .;;;;;;;=%%%%%%;:::::::;%%%%%%%%%%%%%=;;;;;;;.   ######
######    :;;;;;;;;|=%%%%;:::::;%%%%%%%%%%%=|;;;;;;;;:    ######
#######    :;;;;;;;;;;;||=;:::;%%%%%%%=||;;;;;;;;;;;:    #######
########    :;;;;;;;;;;;;;;:::;;;;;;;;;;;;;;;;;;;;;:    ########
########     .:;;;;;;;;;;;;;:;;;;;;;;;;;;;;;;;;;;:.     ########
#########     ..:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:..     #########
###########      .:;;;;;;;;;;;;;;;;;;;;;;;;;;:.      ###########
############       ..:::;;;;;;;;;;;;;;;;:::..       ############
##############          ......::::......          ##############
################                                ################
###################                          ###################
#########################              #########################
################################################################
################################################################

Any advice, criticism, or coding-style improvement suggestion is welcome. It's my first time working in a pure functional programming language, so there is probably some things to improve. I find the applicator function ($) a bit confusing, for example. I also felt a bit hindered by the strictness of the type system, but I guess it's one feature one comes to love when working on a bigger codebase.

\$\endgroup\$
2
\$\begingroup\$

It looks pretty good.

When working with a module that overlaps Prelude, like Data.Vector.Storable, it's more usual to import it with the qualified keyword:

import qualified Data.Vector.Storable as V

and skip the import Prelude as P. Then, in the rest of the code, all functions from the vector module get qualified, and none of the functions from the prelude get qualified. (All Haskell programmers will be familiar with this convention.)

For long pipelines of functions, it's common to write either:

f . g . h $ x

or:

f (g (h x))

but mixing both styles is a little odd. Also, for really long pipelines, it's helpful to write it out on multiple lines, which avoids excessivley long lines and gives plenty of room for comments.

So, I might rewrite imageToAscii as follows. I've gotten rid of the qImg definition and folded it into the pipeline, too:

imageToAscii :: String -> Image Pixel8 -> [String]
imageToAscii mapChar img
  = chunksOf (imageWidth img)
  . V.toList
  . V.map replaceByChar
  . imageData
  . quantizeImage (fromIntegral numBin)
  $ img
  where
    replaceByChar p = mapChar !! fromIntegral p
    numBin = 1 + 255 `div` length mapChar

Similarly in main, it might be more usual to write:

Right img -> putStr $ unlines
                    . imageToAscii replacementChars
                    . rgbaToGray
                    . convertRGBA8
                    $ img

I'm not sure quantize is worth defining, so maybe just:

quantizeImage :: Word8 -> Image Pixel8 -> Image Pixel8
quantizeImage numBin = pixelMap (`div` numBin)

and pixelAvg doesn't look important enough to be a standalone function, so maybe just:

rgbaToGray :: Image PixelRGBA8 -> Image Pixel8
rgbaToGray = pixelMap pixelAvg
  where pixelAvg (PixelRGBA8 r g b a) = round $ 0.2989 * fromIntegral r + 0.5870 * fromIntegral g + 0.1140 * fromIntegral b

Also, quantizeImage is kind of a weird transformation, since the result isn't really intended to be an image. It seems like the quantization ought to be part of the transformation acting on the raw image data, so I might rewrite:

imageToAscii :: String -> Image Pixel8 -> [String]
imageToAscii mapChar img
  = chunksOf (imageWidth img)
  . V.toList
  . V.map (replaceByChar . (`div` fromIntegral numBin))
  . imageData
  $ img
  where
    replaceByChar p = mapChar !! fromIntegral p
    numBin = 1 + 255 `div` length mapChar

Then we start moving into performance-related improvements. Doing a V.toList . V.map f will generally be slower than doing a map f . V.toList. The former forces the mapping to create an entire transformed vector copy of the image. The latter can result in a lazily produced list and might even be optimized via list fusion so intermediate lists aren't produced:

imageToAscii :: String -> Image Pixel8 -> [String]
imageToAscii mapChar img
  = chunksOf (imageWidth img)
  . map (replaceByChar . (`div` fromIntegral numBin))
  . V.toList
  . imageData
  $ img
  where
    replaceByChar p = mapChar !! fromIntegral p
    numBin = 1 + 255 `div` length mapChar

The next big performance problem is replaceByChar. Haskell lists are singly linked lists, so lookups are slow. You can use a vector here, instead:

import Data.Vector.Unboxed as VU

replacementChars :: VU.Vector Char
replacementChars = VU.fromList "#@&%=|;:. "

with corresponding fixes to imageToAscii:

imageToAscii :: VU.Vector Char -> Image Pixel8 -> [String]
imageToAscii mapChar img
  = chunksOf (imageWidth img)
  . map (replaceByChar . (`div` fromIntegral numBin))
  . V.toList
  . imageData
  $ img
  where
    replaceByChar p = mapChar VU.! fromIntegral p
    numBin = 1 + 255 `div` VU.length mapChar

I guess I'd probably fiddle with this a little more. replaceByChar is just a lookup in a map, so it doesn't seem worthy of being named. On the other hand, reintroducing the name quantize in place of numBin, and the (`div` fromIntegral numBin)) expression makes things clearer.

Also, you've giving a bunch of names to your ASCII palette: it's either replacementChars or mapChar, or maybe they're bins (e.g., numBin). Using a single consistent name would make sense. It might be nice to call it a "palette", though palette-related names are already part of Codec.Picture. So, maybe "brush"? If so:

type Brush = VU.Vector Char

defaultBrush :: Brush
defaultBrush = VU.fromList "#@&%=|;:. "

imageToAscii :: Brush -> Image Pixel8 -> [String]
imageToAscii brush img
  = chunksOf (imageWidth img)
  . map (\pix -> brush VU.! quantize pix)
  . V.toList
  . imageData
  $ img
  where
    quantize x = fromIntegral x `div` (1 + 255 `div` VU.length brush)

Also, the logic for quantize isn't very good for general brush sizes. For example, if the brush is 256 characters, it will work pretty well, but what if we have a 255 character brush? I think this will give better results:

  quantize x = fromIntegral x * VU.length brush `div` 256

Your chunksOf, while a reasonable definition, is going to be a lot slower than the version from Data.List.Split, so you'll want to use that.

Finally, since you aren't using the alpha channel, it would be better to drop it from the start with convertRGB8 in place of convertRGBA8, with corresponding changes to rgbaToGray:

rgbaToGray :: Image PixelRGB8 -> Image Pixel8
rgbaToGray = pixelMap toGray
  where toGray (PixelRGB8 r g b)
          = round $ 0.2989 * fromIntegral r + 0.5870 * fromIntegral g + 0.1140 * fromIntegral b

Also note that toGray is a more evocative name than pixelAvg.

Note that all of these performance-related changes really ought to be benchmarked. I found that, on a moderately large JPEG image, the combined effect of all of the above was an approximate 35% reduced runtime.

The biggest improvement came from using the faster chunksOf from Data.List.Split. Switching from a [Char] to a VU.Vector Char brush provided only a modest improvement for such a small brush, which I found surprising, but it might still be worthwhile for larger brushes. By itself, swapping map f . V.toList for V.toList . map f didn't seem to have an effect, but combining the quantization and character mapping in a single map did have a modest effect, meaning that:

map (brush VU.!) . V.toList . V.map quantize

was slower than either of the following:

map (\pix -> brush VU.! quantize pix) . V.toList
V.toList . map (\pix -> brush VU.! quantize pix) 

My final version follows. Again, I think your original was quite good, so I think mine is at best a modest improvement:

import Codec.Picture
import Data.List.Split
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Unboxed as VU

type Brush = VU.Vector Char

defaultBrush :: Brush
defaultBrush = VU.fromList "#@&%=|;:. "

paintImage :: Brush -> Image Pixel8 -> [String]
paintImage brush img
  = chunksOf (imageWidth img)
  . map (\pix -> brush VU.! quantize pix)
  . V.toList
  . imageData
  $ img
  where
    quantize x = fromIntegral x * VU.length brush `div` 256

rgbaToGray :: Image PixelRGB8 -> Image Pixel8
rgbaToGray = pixelMap toGray
  where toGray (PixelRGB8 r g b) = round $ 0.2989 * i r + 0.5870 * i g + 0.1140 * i b
        i = fromIntegral

main :: IO ()
main = do
  img <- readImage "hamburger.png"
  case img of
    Left str -> print str
    Right img -> putStr $ unlines
                        . paintImage defaultBrush
                        . rgbaToGray
                        . convertRGB8
                        $ img
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.