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