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:
################################################################
################################################################
########################### ###########################
###################### ######################
################### ###################
################ .....::..... ################
############## ..::;;;;;;;;;;;;;:.. ##############
############# .::;;;;;;;;;;;;;;;;;;;;::. #############
########### .:;;;;;;;;;;;;;;;;;;;;;;;;;;:. ###########
########## .:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:. ##########
######### :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;: #########
######## .:;;;;;;;;::;;;;;;;;;;;;;;;;::;;;;;;;;:. ########
####### .:;;;;;;;;;..;;;;;;;;;;;;;;;;..;;;;;;;;;:. #######
###### .:;;;;;;;;;;::;;;;;;;::;;;;;;;::;;;;;;;;;;:. ######
###### .:;;;;;;;;;;;;;;;;;;;;..;;;;;;;;;;;;;;;;;;;;:. ######
##### :;;;;;;;;;;;;;;;;;;;;;::;;;;;;;;;;;;;;;;;;;;;: #####
##### .;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;. #####
#### :;;;;;;;::;;;;;;;;;;;;;;;;;;;;;;;;;;;;::;;;;;;;: ####
#### .;;;;;;;;.:;;;;;;;;;;;;;;;;;;;;;;;;;;;;:.;;;;;;;;. ####
#### :;;;;;;;;::;;;;;;;;;;;;;;;;;;;;;;;;;;;;::;;;;;;;;: ####
#### :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;: ####
#### :;;;;;;;;;;;;;;;;;:::;;;;;;;;:::;;;;;;;;;;;;;;;;;: ####
### .;;;;;;;;;;;;;;;;;;:.:;;;;;;;;:.:;;;;;;;;;;;;;;;;;;. ###
### :;;;;;;;;;;;;;;;;;;;:;;;;;;;;;;:;;;;;;;;;;;;;;;;;;;: ###
### ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;: ###
### :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ###
### :;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|: ###
### .|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|: ###
### .;|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;||; ###
### .||;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;||; ###
### .|=|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||; ###
### .;===|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||; ###
### .:=====|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||||: ###
### ::|======||;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|||||||||=: ###
## .;:;======|||||||;;;;;;;;;;;;;;;;;;;;|||||||||||||=|;. ##
## :|::|=====|||||||||||||||||||||||||||||||||||||||==:|: ##
## ;%:::=====|||||||||||||||||||||||||||||||||||||||=|:%; ##
## ;%|::;=======||||||||||||||||||||||||||||||||||||=:|%; ##
## ;%%;::;======||||||||||||||||||||||||||||||||||||:;%%; ##
## :%%%;::;=====|||||||||====;;||||||||||||||||||||:;%%%: ##
## .%%%%;:::|===|||||||====|;::|||||====|||||||||||;%%%%. ##
### |%%%%|::::;=||||||===|;::::;||||=======||||||||%%%%| ###
### .%%%%%=;:::::;;;;;;;::::::::;||;=========|;;||%%%%%. ###
#### ;%%%%%%=;::::::::::::::::::::;:::;;;;;:::;=%%%%%%; ####
#### =%%%%%%%%|:::::::::::::::::::::::::::;|%%%%%%%%= ####
##### ;=%%%%%%%%=;:::::::::::::::::::::;;|%%%%%%%%%%=; #####
##### :;=%%%%%%%%%;::::::::::::::::;|=%%%%%%%%%%%%%=;: #####
##### :;;|%%%%%%%%%;:::::::::::::;=%%%%%%%%%%%%%%%|;;: #####
##### .;;;;=%%%%%%%%;:::::::::::;%%%%%%%%%%%%%%%=;;;;. #####
##### :;;;;|=%%%%%%%;:::::::::;%%%%%%%%%%%%%%=|;;;;: #####
###### .;;;;;;;=%%%%%%;:::::::;%%%%%%%%%%%%%=;;;;;;;. ######
###### :;;;;;;;;|=%%%%;:::::;%%%%%%%%%%%=|;;;;;;;;: ######
####### :;;;;;;;;;;;||=;:::;%%%%%%%=||;;;;;;;;;;;: #######
######## :;;;;;;;;;;;;;;:::;;;;;;;;;;;;;;;;;;;;;: ########
######## .:;;;;;;;;;;;;;:;;;;;;;;;;;;;;;;;;;;:. ########
######### ..:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:.. #########
########### .:;;;;;;;;;;;;;;;;;;;;;;;;;;:. ###########
############ ..:::;;;;;;;;;;;;;;;;:::.. ############
############## ......::::...... ##############
################ ################
################### ###################
######################### #########################
################################################################
################################################################
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.
1 Answer 1
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