Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Here I present some functions I wrote to recreate some of the most common image effect available in all image editor.
They require the library rimage.

y <- read.jpeg("path")

To display the image, use:

plot(y)

Original image

Sepia tone

rgb2sepia <- function(img){
iRed <- img[,,1]*255
iGreen <- img[,,2]*255
iBlue <- img[,,3]*255

oRed <- iRed * .393 + iGreen * .769 + iBlue * .189
oGreen <- iRed * .349 + iGreen * .686 + iBlue * .168
oBlue <- iRed * .272 + iGreen * .534 + iBlue * .131

qw <- array( c(oRed/255 , oGreen/255 , oBlue/255), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2sepia(y))

Negative

rgb2neg <- function(img){
iRed <- img[,,1]
iGreen <- img[,,2]
iBlue <- img[,,3]

oRed <- (1 - iRed)
oGreen <- (1 - iGreen)
oBlue <- (1 - iBlue)

qw <- array( c(oRed, oGreen, oBlue), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2neg(y))

Pixelation

pixmatr <- function(a, n){
aa <- seq(1,dim(a)[1],n)
ll <- seq(1,dim(a)[2],n)

for(i in 1:(length(aa)-1) ){
for(j in 1:(length(ll)-1) ){
sub1 <- a[aa[i]:(aa[i+1]-1),ll[j]:(ll[j+1]-1)]
k <- mean(sub1)
sub1m <- matrix( rep(k, n*n), n, n)
a[aa[i]:(aa[i+1]-1),ll[j]:(ll[j+1]-1)] <- sub1m
}
}

for(j in 1:(length(ll)-1) ){
sub1 <- a[max(aa):dim(a)[1],ll[j]:(ll[j+1]-1)]
k <- mean(sub1)
sub1m <- matrix( rep(k, nrow(sub1)*ncol(sub1)), nrow(sub1), ncol(sub1))
a[max(aa):dim(a)[1],ll[j]:(ll[j+1]-1)] <- sub1m
}

for(i in 1:(length(aa)-1) ){
sub1 <- a[aa[i]:(aa[i+1]-1),max(ll):dim(a)[2]]
k <- mean(sub1)
sub1m <- matrix( rep(k, nrow(sub1)*ncol(sub1)), nrow(sub1), ncol(sub1))
a[aa[i]:(aa[i+1]-1),max(ll):dim(a)[2]] <- sub1m
}

sub1 <- a[max(aa):dim(a)[1], max(ll):dim(a)[2]]
k <- mean(sub1)
sub1m <- matrix( rep(k, nrow(sub1)*ncol(sub1)), nrow(sub1), ncol(sub1))
a[max(aa):dim(a)[1], max(ll):dim(a)[2]] <- sub1m

a
}

rgb2pix <- function(img,n){
iRed <- img[,,1]*255
iGreen <- img[,,2]*255
iBlue <- img[,,3]*255

oRed <- pixmatr(iRed,n)
oGreen <- pixmatr(iGreen,n)
oBlue <- pixmatr(iBlue,n)

qw <- array( c(oRed/255 , oGreen/255 , oBlue/255), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2pix(y, 6))
plot(rgb2pix(y, 10))

Remove red

rgb2blu <- function(img){
iRed <- img[,,1]
iGreen <- img[,,2]
iBlue <- img[,,3]

oRed <- matrix(0, dim(iRed)[1], dim(iRed)[2])
oGreen <- iGreen
oBlue <- iBlue

qw <- array( c(oRed, oGreen, oBlue), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2blu(y))

Remove green

rgb2vio <- function(img){
iRed <- img[,,1]
iGreen <- img[,,2]
iBlue <- img[,,3]

oRed <- iRed
oGreen <- matrix(0, dim(iRed)[1], dim(iRed)[2])
oBlue <- iBlue

qw <- array( c(oRed, oGreen, oBlue), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2vio(y))

Remove blue

rgb2yel <- function(img){
iRed <- img[,,1]
iGreen <- img[,,2]
iBlue <- img[,,3]

oRed <- iRed
oGreen <- iGreen
oBlue <- matrix(0, dim(iRed)[1], dim(iRed)[2])

qw <- array( c(oRed, oGreen, oBlue), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2yel(y))

rgb2bri <- function(img, n){
iRed <- img[,,1]
iGreen <- img[,,2]
iBlue <- img[,,3]

oRed <- iRed + (iRed * n)
oGreen <- iGreen + (iGreen * n)
oBlue <- iBlue + (iBlue * n)

qw <- array( c(oRed, oGreen, oBlue), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2bri(y, +0.5))
plot(rgb2bri(y, -0.5))

Truncate colors into bands (posterize)

rgb2ban <- function(img, n){
iRed <- img[,,1]*255
iGreen <- img[,,2]*255
iBlue <- img[,,3]*255

band_size <- trunc(255/n)

oRed <- band_size * trunc(iRed / band_size)
oGreen <- band_size * trunc(iGreen / band_size)
oBlue <- band_size * trunc(iBlue / band_size)

qw <- array( c(oRed/255, oGreen/255, oBlue/255), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2ban(y, 5))
plot(rgb2ban(y, 10))

Solarize

rgb2sol <- function(img){
iRed <- img[,,1]*255
iGreen <- img[,,2]*255
iBlue <- img[,,3]*255

for(i in 1:dim(iRed)[1]){
for(j in 1:dim(iRed)[2]){
if(iRed[i,j]<128) iRed[i,j] <- 255-2*iRed[i,j]
else iRed[i,j] <- 2*(iRed[i,j]-128)
}
}

for(i in 1:dim(iGreen)[1]){
for(j in 1:dim(iGreen)[2]){
if(iGreen[i,j]<128) iGreen[i,j] <- 255-2*iGreen[i,j]
else iGreen[i,j] <- 2*(iGreen[i,j]-128)
}
}

for(i in 1:dim(iBlue)[1]){
for(j in 1:dim(iBlue)[2]){
if(iBlue[i,j]<128) iBlue[i,j] <- 255-2*iBlue[i,j]
else iBlue[i,j] <- 2*(iBlue[i,j]-128)
}
}

qw <- array( c(iRed/255, iGreen/255, iBlue/255), dim=c(dim(iRed)[1],dim(iRed)[2],3) )

imagematrix(qw, type="rgb")
}

plot(rgb2sol(y))

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.