Skip to content

Instantly share code, notes, and snippets.

@jonesor

jonesor/palettebuildr.R

Last active Aug 29, 2015
Embed
What would you like to do?
Extract colours from a JPG file to use as a (divergent) colour palette.
palettebuildr <- function(pathToJPEG = "logo.jpg", ncols = 3, dist.method = "euclidian", clust.method = "complete"){
require(jpeg)
#Read in the jpeg file
img <- readJPEG(pathToJPEG)
#Using the whole image is overkill, especially for large files.
#Therefore, create a grid from which extract the colors
xgrid <- ceiling(seq(1, dim(img)[1], length.out = 50))
ygrid <- ceiling(seq(1, dim(img)[2], length.out = 50))
pixels <- expand.grid(xgrid, ygrid)
#Get the red/green/blue values for each pixel
pixels$redVals <- apply(pixels, 1, function(x){return(img[x[1], x[2], ][1])})
pixels$greenVals <- apply(pixels, 1, function(x){return(img[x[1], x[2], ][2])})
pixels$blueVals <- apply(pixels, 1, function(x){return(img[x[1] ,x[2], ][3])})
#Get the euclidian distances of the colour values.
#This creates a distance matrix showing how similar the pixels
#are to eachother.
distMat <- dist(pixels[, 3:5], method = dist.method)
#Use hierarchical clustering to group the colours into n groups
x <- hclust(distMat,method = clust.method)
#Assign each pixel to one of k-groups based on clustering
pixels$groups <- cutree(x, k = ncols)
#Take average red/green/blue values for the whole group
redGroup <- tapply(pixels$redVals, pixels$groups, mean)
greenGroup <- tapply(pixels$greenVals, pixels$groups, mean)
blueGroup <- tapply(pixels$blueVals, pixels$groups, mean)
#Create a dataframe of colours to return
groupCols <- data.frame(gp = 1:ncols, red = redGroup, green = greenGroup, blue=blueGroup)
groupCols$hexCode <- rgb(red = groupCols$red, green = groupCols$green, blue = groupCols$blue, alpha = 1, maxColorValue = 1)
return(groupCols)
}
@jonesor

This comment has been minimized.

Copy link
Owner Author

@jonesor jonesor commented Feb 22, 2015

Use like this:

colorPalette = palettebuildr("starrynight.jpg", ncols = 5)
pie(rep(1, nrow(colorPalette)), col = colorPalette$hexCode,
    labels = substr(colorPalette$hexCode, 1, 7), border = "white")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.