From 9c4541dbe60ca4b5c4e2d4eff1d3b5a44196eec0 Mon Sep 17 00:00:00 2001
From: Beaudette <dylan.beaudette@usda.gov>
Date: Thu, 19 Oct 2023 15:57:29 -0700
Subject: [PATCH] organizing, new ideas

---
 misc/sandbox/RIC-as-color-wheel.R             |  2 +-
 misc/sandbox/munsell-absorbance.R             | 61 +++++++++++++++++++
 misc/sandbox/supercells/hz-morph-supercells.R |  5 +-
 3 files changed, 65 insertions(+), 3 deletions(-)
 create mode 100644 misc/sandbox/munsell-absorbance.R

diff --git a/misc/sandbox/RIC-as-color-wheel.R b/misc/sandbox/RIC-as-color-wheel.R
index ce4e3c77d..611a9d18e 100644
--- a/misc/sandbox/RIC-as-color-wheel.R
+++ b/misc/sandbox/RIC-as-color-wheel.R
@@ -10,7 +10,7 @@ library(soilDB)
 library(ggplot2)
 library(forcats)
 
-x <- fetchKSSL('bearden', returnMorphologicData = TRUE, simplifyColors = TRUE)
+x <- fetchKSSL('clarksville', returnMorphologicData = TRUE, simplifyColors = TRUE)
 s <- x$SPC
 
 ## only pedons with complete colors
diff --git a/misc/sandbox/munsell-absorbance.R b/misc/sandbox/munsell-absorbance.R
new file mode 100644
index 000000000..3aac5a7eb
--- /dev/null
+++ b/misc/sandbox/munsell-absorbance.R
@@ -0,0 +1,61 @@
+library(aqp)
+library(lattice)
+library(tactile)
+library(sharpshootR)
+
+# need this for mixingMethod = 'reference'
+library(gower)
+
+# need this for colorMixtureVenn()
+library(venn)
+
+# local copy of the Munsell chip spectral library
+# c/o http://www.munsellcolourscienceforpainters.com/
+# odd chroma spectra via interpolation
+# see ?munsell.spectra for details
+# try aqp:::.summarizeMunsellSpectraRanges()
+data(munsell.spectra)
+
+# all hues, limit to specific hue / chroma slice
+x <- munsell.spectra[munsell.spectra$value  == 6 & munsell.spectra$chroma == 8, ]
+
+# each Munsell chip has a 36-element spectra
+# ranging from 380-730 nm
+# table(x$munsell)
+
+# spectra IDs
+x$ID <- factor(x$munsell)
+# create a color / chip
+cols <- parseMunsell(as.character(levels(x$ID)))
+
+# plot style
+tps <- tactile.theme(superpose.line = list(col = cols, lwd = 2))
+
+# R -> A
+x$A <- log(1 / x$reflectance, base = 10)
+
+
+# final figure
+xyplot(
+  reflectance ~ wavelength, groups = ID, data = x, 
+  par.settings = tps,
+  main = 'Value 6 / Chroma 8',
+  type = c('l', 'g'),
+  ylab = 'Reflectance',
+  xlab = 'Wavelength (nm)',
+  scales = list(tick.number = 12),
+  xlim = c(370, 740)
+)
+
+
+xyplot(
+  A ~ wavelength, groups = ID, data = x, 
+  par.settings = tps,
+  main = 'Value 6 / Chroma 8',
+  type = c('l', 'g'),
+  ylab = 'Absorbance',
+  xlab = 'Wavelength (nm)',
+  scales = list(tick.number = 12),
+  xlim = c(370, 740)
+)
+
diff --git a/misc/sandbox/supercells/hz-morph-supercells.R b/misc/sandbox/supercells/hz-morph-supercells.R
index d192903e0..2530ec262 100644
--- a/misc/sandbox/supercells/hz-morph-supercells.R
+++ b/misc/sandbox/supercells/hz-morph-supercells.R
@@ -6,7 +6,7 @@ library(supercells)
 
 x <- rast('leaf-john-kelley.jpg')
 
-s <- supercells(x, k = 500, compactness = 10, transform = 'to_LAB')
+s <- supercells(x, k = 7, compactness = 30, transform = 'to_LAB', verbose = 2, avg_fun = median)
 
 plotRGB(x)
 plot(st_geometry(s), add = TRUE, border = 'yellow')
@@ -15,7 +15,8 @@ cols <- rgb(s$leaf.john.kelley_1, s$leaf.john.kelley_2, s$leaf.john.kelley_3, ma
 
 par(mfcol = c(1, 2))
 plotRGB(x, mar = c(0, 0, 0, 0))
-plot(st_geometry(s), col = cols, border = NA, mar = c(0, 0, 0, 0))
+par(mar = c(0, 0, 0, 0))
+plot(st_geometry(s), col = cols, border = NA)
 
 m <- rgb2munsell(cbind(s$leaf.john.kelley_1, s$leaf.john.kelley_2, s$leaf.john.kelley_3) / 255)