Do not believe anything: what artists really do is to hang around all day (Paco de Lucia)
Andy Warhol was mathematician. At least, he knew how clustering algorithms work. I am pretty sure of this after doing this experiment. First of all, let me introduce you to the breathtaking Grace Kelly:
In my previous post I worked also with images showing how simple is to operate with them since they are represented by matrices. This is another example of this. Third dimension of an image matrix is an 3D array representing color of pixels in (r, g, b) format. Applying a cluster algorithm over this information generates groups of pixels with similar color. I used cluster
package and because of the high size of picture I decided to use clara algorithm which is extremely fast. Apart of its high speed, another advantage of clara is that clusters are represented by real elements of the population, called medoids, instead of being by average individuals as k-means do. It fits very well with my purposes because once clusters are calculated I only have to change each pixel by its medoid and plot it. Setting clara to divide pixels into 2 groups, generates a 2 colored image. Setting it to 3 groups, generates a 3 colored one and so on. Following, you can find results from 2 to 7 groups:
Working with samples can be a handicap, maybe less important than the speed it produces. Sometimes images generated by n groups seems to be worse fitted than the one generated by n-1 groups. You can see it in this video, where results from 1 to 60 groups are presented sequentially. It only takes 42 seconds.
Here you have the code. Feel free to warholing:
library("biOps") library("abind") library("reshape") library("reshape2") library("cluster") library("sp") ####################################################################################################### #Initialization ####################################################################################################### x <- readJpeg("936full-grace-kelly.jpg") plot(x) ####################################################################################################### #Data ####################################################################################################### data <- merge(merge(melt(x[,,1]), melt(x[,,2]), by=c("X1", "X2")), melt(x[,,3]), by=c("X1", "X2")) colnames(data) <- c("X1", "X2", "r", "g", "b") ####################################################################################################### #Clustering ####################################################################################################### colors <- 5 clarax <- clara(data[,3:5], colors) datacl <- data.frame(data, clarax$cluster) claradf2 <- as.data.frame(clarax$medoids) claradf2$id <- as.numeric(rownames(claradf2)) colnames(claradf2) <- c("r", "g", "b", "clarax.cluster") claradf <- merge(datacl, claradf2, by=c("clarax.cluster")) colnames(claradf) <-c("clarax.cluster", "X1", "X2", "r.x", "g.x", "b.x", "r.y", "g.y", "b.y") datac <- claradf[do.call("order", claradf[c("X1", "X2")]), ] x1<-acast(datac[,c(2,3,7)], X1~X2, value.var="r.y") x2<-acast(datac[,c(2,3,8)], X1~X2, value.var="g.y") x3<-acast(datac[,c(2,3,9)], X1~X2, value.var="b.y") warhol <- do.call(abind, c(list(x1,x2,x3), along = 3)) plot(imagedata(warhol)) writeJpeg(paste("Warholing", as.character(colors), ".jpg", sep=""), imagedata(warhol))