misc/sandbox/pretty-soil-jars.R

In ncss-tech/aqp: Algorithms for Quantitative Pedology

library(aqp)


# x <- read.table(textConnection(readClipboard()), header = FALSE)
# names(x) <- c('r', 'g', 'b')
# x <- x / 255

x <- structure(
  list(
    r = c(0.149019607843137, 0.4, 0.517647058823529, 
          0.592156862745098, 0.580392156862745, 0.709803921568627, 0.6, 
          0.717647058823529, 0.768627450980392, 0.745098039215686, 0.768627450980392, 
          0.686274509803922, 0.807843137254902, 0.588235294117647, 0.682352941176471, 
          0.713725490196078), 
    g = c(0.152941176470588, 0.32156862745098, 
          0.325490196078431, 0.235294117647059, 0.274509803921569, 0.470588235294118, 
          0.384313725490196, 0.537254901960784, 0.643137254901961, 0.694117647058824, 
          0.764705882352941, 0.72156862745098, 0.764705882352941, 0.533333333333333, 
          0.56078431372549, 0.635294117647059), 
    b = c(0.133333333333333, 
          0.184313725490196, 0.105882352941176, 0.0117647058823529, 0.0156862745098039, 
          0.113725490196078, 0, 0, 0.254901960784314, 0.47843137254902, 
          0.647058823529412, 0.654901960784314, 0.686274509803922, 0.380392156862745, 
          0.349019607843137, 0.388235294117647)
  ), 
  class = "data.frame", row.names = c(NA, -16L)
)

m <- col2Munsell(x)
m$label <- sprintf("%s %s/%s", m$hue, m$value, m$chroma)
m$color <- rgb(x)

par(mar = c(0, 0, 0, 0))
soilPalette(m$color, lab = m$label)

par(mar = c(0, 0, 0, 0), bg = grey(0.95), fg = 'black')
mds <- previewColors(m$color, method = 'MDS', pt.cex = 6)
text(mds, labels = 1:nrow(m), col = invertLabelColor(m$color), font = 2)
points(0, 0, pch = 22, bg = 'royalblue', cex = 4)