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:
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)







Floyd-Steinberg dithering


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







Bill Atkinson dithering


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







Jarvis-Judice-Ninke dithering


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







Sierra 2-4a dithering filter


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







Stucki dithering


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







Burkes dithering


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







Sierra2 dithering


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







Sierra3 dithering


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

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)