Create a color palette for xterm from a JPEG using k-means.

k-means-color.R

#!/usr/bin/Rscript
## Generate a color palette for an image using k-Means
## Joshua Moller-Mara
library(jpeg)
library(colorspace)
library(rgl)
args <- commandArgs(trailingOnly = TRUE)

plotPalette <- function(palette) {
    barplot(rep(1,length(palette)), yaxt="n", col=palette)
}

printPalette <- function(palette) {
    cat(paste0("XTerm*",
               c("background", "foreground",
                 paste0("color", rep(0:7, each=2) + c(0,8)))
               , ":  ", palette, "\n"))
}

##############################
## LAB
##############################
raster <- readJPEG(args[1])
X11()
par(mar=c(0, 0, 0, 0))
plot(1:2, type='n')
rasterImage(raster, 1, 1, 2, 2)
jpg <- apply(raster, 3, function(x) x) #Read and flatten

## Sample some RGB values
rgbs <- jpg[sample(nrow(jpg), 40000),]
 
x <- RGB(rgbs[,1], rgbs[,2], rgbs[,3])
labs <- as(x, "LAB")@coords

## Plot LAB in 3D space
with(as.data.frame(labs), plot3d(L, A, B,
       col=rgb(rgbs[,1], rgbs[,2], rgbs[,3]),
       xlab = "L", ylab = "A", zlab = "B"))
play3d(spin3d(axis=c(0,0,1), rpm=60/3), duration=3)

km <- kmeans(labs, 18, iter.max=16)
## Prefer the most common color first
centers <- km$centers[order(table(km$cluster), decreasing=TRUE),]
## Prefer darker colors first. (For the dark background)
## centers <- km$centers[order(km$centers[,1]),]
rownames(centers) <- 1:nrow(centers)

## Can we sort the palette in a better way?
## Use as.matrix(dist(centers))?
## By clustering into nearest pairs?
## centers <- centers[kmeans(centers, 9, iter.max=30)$cluster,]

distmat <- as.matrix(dist(centers))

## Find most dissimilar colors for foreground and background
## Then find most similar pairs
maxclust <- function(distmat, max=TRUE, i=1) {
    if(nrow(distmat) < 1)
        return(NULL)
    first <- rownames(distmat)[i]
    excl <<- distmat[-i,i,drop=FALSE]    #Exclude me
    ind <- (if(max){which.max}else{which.min})(excl)
    (nxt <- rownames(excl)[ind])
    newDM <<- distmat[-i,-i,drop=FALSE]
    newDM <<- newDM[-ind,-ind,drop=FALSE]
    findMostDiff <<- distmat[-i, i, drop=FALSE]
    newi <- which.max(findMostDiff[-ind,, drop=FALSE])
    as.numeric(c(first, nxt, maxclust(newDM, max=FALSE, i=newi)))
}

centers <- centers[maxclust(distmat),]

rmus <- 
    with(as.data.frame(centers),
         as(LAB(L, A, B), "RGB")@coords)

palette <- with(as.data.frame(rmus), rgb(R, G, B))
X11()
plotPalette(palette)

printPalette(palette)

zz <- pipe(paste("xrdb -merge"), "w")
sink(zz)
printPalette(palette)
sink()
close(zz)
Sys.sleep(3)