R is a cool image editor #2: Dithering algorithms
[This article was first published on Statistic on aiR, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Here I implemented in R some dithering algorithms:
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
– Floyd-Steinberg dithering
– Bill Atkinson dithering
– Jarvis-Judice-Ninke dithering
– Sierra 2-4a dithering
– Stucki dithering
– Burkes dithering
– Sierra2 dithering
– Sierra3 dithering
For each algorithm, I wrote a 2-dimensional convolution function (a matrix passing over a matrix); it is slow because I didn’t implemented any fasting tricks. It can be easily implemented in C, then used in R for a faster solution.
Then, a function to transform a grey image in a grey-dithered image is provided, with an example. The library rimage was used for loading and displaying images (see the other post R is a cool image editor).
These function can be easily re-coded for a RGB image.
Only the first code is commented, ’cause they’re all very similar.
library(rimage) y <- read.jpeg("valve.jpg") plot(y)

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Floyd-Steinberg dithering | |
# the 2-dimensional convolution function | |
FloydConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 1:(dim(a)[1]-1)){ | |
for(j in 1:(dim(a)[2]-1)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 7/16) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 3/16) | |
a[i+1,j] <- a[i+1,j] + (e * 5/16) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 1/16) | |
} | |
} | |
a | |
} | |
# the main function | |
grey2FSdith <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 1 | |
dim2 <- 1 | |
dim1x <- 1 | |
dim2x <- 1 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
# this code creates a bigger matrix (image) adding 0.5 values in first/last row/col | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2, ncol=ncol(greyMatrix)+2) | |
tempMatrix[2:(nrow(tempMatrix)-1),2:(ncol(tempMatrix)-1)] <- greyMatrix | |
# apply the convolution function | |
igrey <- FloydConvolution(tempMatrix) | |
# create the image | |
imagematrix(igrey[1:(nrow(igrey)-1),1:(ncol(igrey)-1)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2FSdith(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Bill Atkinson dithering | |
AtkinConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 1/8) | |
a[i,j+2] <- a[i,j+2] + (e * 1/8) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 1/8) | |
a[i+1,j] <- a[i+1,j] + (e * 1/8) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 1/8) | |
a[i+2,j] <- a[i+2,j] + (e * 1/8) | |
} | |
} | |
a | |
} | |
grey2ATKdith <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- AtkinConvolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2ATKdith(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Jarvis-Judice-Ninke dithering | |
JJNConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 7/48) | |
a[i,j+2] <- a[i,j+2] + (e * 5/48) | |
a[i+1,j-2] <- a[i+1,j-2] + (e * 3/48) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 5/48) | |
a[i+1,j] <- a[i+1,j] + (e * 7/48) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 5/48) | |
a[i+1,j+2] <- a[i+1,j+2] + (e * 3/48) | |
a[i+2,j-2] <- a[i+2,j-2] + (e * 1/48) | |
a[i+2,j-1] <- a[i+2,j-1] + (e * 3/48) | |
a[i+2,j] <- a[i+2,j] + (e * 5/48) | |
a[i+2,j+1] <- a[i+2,j+1] + (e * 3/48) | |
a[i+2,j+2] <- a[i+2,j+2] + (e * 1/48) | |
} | |
} | |
a | |
} | |
grey2JJNdith <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- JJNConvolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2JJNdith(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Sierra 2-4a dithering filter | |
Sierra24aConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 2/4) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 1/4) | |
a[i+1,j] <- a[i+1,j] + (e * 1/4) | |
} | |
} | |
a | |
} | |
grey2S24adith <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*1, ncol=ncol(greyMatrix)+2*1) | |
tempMatrix[2:(nrow(tempMatrix)-1),2:(ncol(tempMatrix)-1)] <- greyMatrix | |
igrey <- Sierra24aConvolution(tempMatrix) | |
imagematrix(igrey[2:(nrow(igrey)-1),2:(ncol(igrey)-1)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2S24adith(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Stucki dithering | |
StuckiConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 8/42) | |
a[i,j+2] <- a[i,j+2] + (e * 4/42) | |
a[i+1,j-2] <- a[i+1,j-2] + (e * 2/42) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 4/42) | |
a[i+1,j] <- a[i+1,j] + (e * 8/42) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 4/42) | |
a[i+1,j+2] <- a[i+1,j+2] + (e * 2/42) | |
a[i+2,j-2] <- a[i+2,j-2] + (e * 1/42) | |
a[i+2,j-1] <- a[i+2,j-1] + (e * 2/42) | |
a[i+2,j] <- a[i+2,j] + (e * 4/42) | |
a[i+2,j+1] <- a[i+2,j+1] + (e * 2/42) | |
a[i+2,j+2] <- a[i+2,j+2] + (e * 1/42) | |
} | |
} | |
a | |
} | |
grey2Stucki <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- StuckiConvolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2Stucki(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Burkes dithering | |
BurkesConvolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 4/32) | |
a[i,j+2] <- a[i,j+2] + (e * 4/32) | |
a[i+1,j-2] <- a[i+1,j-2] + (e * 2/32) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 4/32) | |
a[i+1,j] <- a[i+1,j] + (e * 8/32) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 4/32) | |
a[i+1,j+2] <- a[i+1,j+2] + (e * 2/32) | |
} | |
} | |
a | |
} | |
grey2Burkes <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- BurkesConvolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2Burkes(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Sierra2 dithering | |
Sierra2Convolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 4/16) | |
a[i,j+2] <- a[i,j+2] + (e * 3/16) | |
a[i+1,j-2] <- a[i+1,j-2] + (e * 1/16) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 2/16) | |
a[i+1,j] <- a[i+1,j] + (e * 3/16) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 2/16) | |
a[i+1,j+2] <- a[i+1,j+2] + (e * 1/16) | |
} | |
} | |
a | |
} | |
grey2Sierra2 <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- Sierra2Convolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2Sierra2(rgb2grey(y))))

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Sierra3 dithering | |
Sierra3Convolution <- function(a){ | |
c <- matrix(0, nrow=dim(a)[1], ncol=dim(a)[2]) | |
for(i in 2:(dim(a)[1]-2)){ | |
for(j in 2:(dim(a)[2]-2)){ | |
P <- trunc(a[i,j]+0.5) | |
e <- a[i,j] - P | |
a[i,j] <- P | |
a[i,j+1] <- a[i,j+1] + (e * 5/32) | |
a[i,j+2] <- a[i,j+2] + (e * 3/32) | |
a[i+1,j-2] <- a[i+1,j-2] + (e * 2/32) | |
a[i+1,j-1] <- a[i+1,j-1] + (e * 4/32) | |
a[i+1,j] <- a[i+1,j] + (e * 5/32) | |
a[i+1,j+1] <- a[i+1,j+1] + (e * 4/32) | |
a[i+1,j+2] <- a[i+1,j+2] + (e * 2/32) | |
a[i+2,j-1] <- a[i+2,j-1] + (e * 2/32) | |
a[i+2,j] <- a[i+2,j] + (e * 3/32) | |
a[i+2,j+1] <- a[i+2,j+1] + (e * 2/32) | |
} | |
} | |
a | |
} | |
grey2Sierra3 <- function(img){ | |
greyMatrix <- img[1:nrow(img),1:ncol(img)] | |
dim1 <- 2 | |
dim2 <- 2 | |
dim1x <- 2 | |
dim2x <- 2 | |
dim1a <- dim(greyMatrix)[1] | |
dim2a <- dim(greyMatrix)[2] | |
tempMatrix <- matrix(0.5, nrow=nrow(greyMatrix)+2*2, ncol=ncol(greyMatrix)+2*2) | |
tempMatrix[3:(nrow(tempMatrix)-2),3:(ncol(tempMatrix)-2)] <- greyMatrix | |
igrey <- Sierra3Convolution(tempMatrix) | |
imagematrix(igrey[3:(nrow(igrey)-2),3:(ncol(igrey)-2)], type="grey", noclipping=TRUE) | |
} |
plot(normalize(grey2Sierra3(rgb2grey(y))))

To leave a comment for the author, please follow the link and comment on their blog: Statistic on aiR.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.