Skip to content

Commit

Permalink
organizing, new ideas
Browse files Browse the repository at this point in the history
  • Loading branch information
dylanbeaudette committed Oct 19, 2023
1 parent ce31fd3 commit 9c4541d
Show file tree
Hide file tree
Showing 3 changed files with 65 additions and 3 deletions.
2 changes: 1 addition & 1 deletion misc/sandbox/RIC-as-color-wheel.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
61 changes: 61 additions & 0 deletions misc/sandbox/munsell-absorbance.R
Original file line number Diff line number Diff line change
@@ -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)
)

5 changes: 3 additions & 2 deletions misc/sandbox/supercells/hz-morph-supercells.R
Original file line number Diff line number Diff line change
Expand Up @@ -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')
Expand All @@ -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)

Expand Down

0 comments on commit 9c4541d

Please sign in to comment.