A Dental Shade Guide is a set of simulated teeth used to select prosthetic teeth by color. The simulated teeth are made of plastic or porcelain. Commercial shade guides have existed for almost a century. In 1933, Clark [1] discussed the manufacture and use of porcelain shade guides based on the cylindrical color dimensions of hue, brilliance, and saturation, which correspond to Munsell’s Hue, Value, and Chroma.
In [3], the 24 teeth in a master Bioform shade guide were measured with a spectrophotometer. The spectral measurements were converted to xyY assuming Illuminant C, and then to both CIE Lab and Munsell HVC. The goal of this vignette is to plot the 24 colors as square patches, and then check the calculations from the article.
The spectrophotometer was an ACTA CIII from Beckman Instruments. Relative reflectance data were recorded from 410 to 700nm at 10-nm intervals. The conversion from such data to xyY and Lab is standard, but conversion to Munsell HVC is not explained in the paper. However, in a similar article [4] by the same authors they state that:
The chromaticity coordinates were converted to Munsell notation by means of graphs … and the method described by ASTM standard D 1535-80.
so we assume that the same method was used here. Note that the graphical method only applies to Munsell Hue and Chroma; for Munsell Value lookup tables are available in [2]. Below we check the published conversions against numerical conversions using munsellinterpol.
Load the required R packages.
library(munsellinterpol)
library(spacesRGB) # for converting to RGB and plotting the patches
library(spacesXYZ) # for xyY<->XYZ and Chromatic Adaptation Transform
Featured functions from munsellinterpol are
XYZtoMunsell()
, MunsellNameFromHVC()
,
NickersonColorDifference()
, and
ColorBlockFromMunsell()
.
Read the published data table.
path = system.file( 'extdata/dental.txt', package='munsellinterpol' )
dental = read.table( path, header=TRUE, sep='\t', stringsAsFactors=FALSE )
dental
## Y x y L a b Munsell
## B-96 37.05 0.3610 0.3641 67.34 1.31 19.93 1.9Y 6.55/2.9
## B-84 37.98 0.3663 0.3653 68.01 2.74 21.21 0.9Y 6.65/3.2
## B-85 38.24 0.3811 0.3794 68.23 2.91 27.38 1.8Y 6.65/4.1
## B-81 38.82 0.3588 0.3616 68.65 1.43 19.24 1.5Y 6.60/2.8
## B-95 41.22 0.3502 0.3570 70.36 0.03 17.07 2.6Y 6.85/2.4
## B-94 42.30 0.3548 0.3627 71.11 -0.32 19.48 3.0Y 6.95/2.7
## B-69 42.49 0.3545 0.3614 71.24 0.03 19.11 2.6Y 6.95/2.6
## B-83 43.25 0.3693 0.3701 71.52 2.25 23.94 1.3Y 7.00/3.6
## B-77 44.09 0.3572 0.3628 72.32 0.50 20.16 2.3Y 7.05/2.8
## B-93 45.01 0.3526 0.3584 72.93 0.40 18.34 2.2Y 7.15/2.6
## B-67 46.26 0.3614 0.3681 73.74 0.14 22.66 2.5Y 7.20/3.2
## B-55 47.10 0.3558 0.3639 74.28 -0.39 20.69 2.9Y 7.30/2.9
## B-56 47.80 0.3581 0.3633 74.73 0.66 21.00 2.0Y 7.30/2.9
## B-92 48.67 0.3429 0.3514 75.28 -0.66 15.27 3.0Y 7.35/2.0
## B-65 49.14 0.3606 0.3629 75.57 1.73 21.48 1.1Y 7.30/3.1
## B-54 49.15 0.3532 0.3589 75.58 0.46 19.13 2.0Y 7.40/2.7
## B-53 49.39 0.3499 0.3559 75.72 0.33 17.76 2.1Y 7.40/2.5
## B-91 49.57 0.3406 0.3484 75.84 -0.42 14.14 2.4Y 7.45/1.9
## B-62 49.92 0.3454 0.3539 76.05 -0.64 16.53 3.1Y 7.45/2.3
## B-63 50.00 0.3548 0.3594 76.10 0.87 19.64 1.7Y 7.45/2.8
## B-52 50.42 0.3451 0.3553 76.36 -1.28 16.94 3.6Y 7.50/2.1
## B-66 51.21 0.3534 0.3615 76.84 -0.42 20.18 2.8Y 7.55/2.8
## B-51 55.24 0.3432 0.3525 79.21 -0.99 16.31 3.2Y 7.80/2.2
## B-59 55.72 0.3407 0.3502 79.49 -1.10 15.26 3.5Y 7.80/2.0
Extract xyY, adapt from Illuminant C to D65, convert XYZ to sRGB, and display as a 6x4 grid of patches.
xyY = as.matrix( dental[ c('x','y','Y') ] )
XYZ = XYZfromxyY( xyY ) / 100
# adapt from Illuminant C to the whitepoint of sRGB, which is D65
# make the Chromatic Adaptation Transform
theCAT = spacesXYZ::CAT( 'C', getWhiteXYZ('sRGB',which='display') )
XYZ = adaptXYZ( theCAT, XYZ )
# create data.frame obj for plotting
obj = expand.grid( LEFT=1:6, TOP=1:4 )
obj$WIDTH = 0.9
obj$HEIGHT = 0.9
obj$RGB = RGBfromXYZ( XYZ, space='sRGB' )$RGB # convert to sRGB
rownames(obj) = rownames(dental)
# plot as square patches
par( omi=c(0,0,0,0), mai=c(0.1,0.1,0.1,0.1) )
plotPatchesRGB( obj, which='signal', labels="bottomleft", adj=c(-0.2,-0.5), cex=0.7 )
This figure is best viewed on a display calibrated for sRGB.
We now recompute Lab and Munsell values, and check against the published values.
Lab = as.matrix( dental[ c('L','a','b') ] )
XYZ = XYZfromxyY( xyY )
Lab2 = LabfromXYZ( XYZ/100, 'C' ) # recompute Lab
HVC = HVCfromMunsellName( dental$Munsell )
HVC2 = XYZtoMunsell( XYZ ) # recompute Munsell HVC
comp = data.frame( row.names=rownames(dental) )
comp$Y = dental$Y
comp$L = Lab[ ,1]
comp$L2 = round(Lab2[ ,1],4)
comp$Ldiff = round( comp$L - comp$L2, 4 )
comp$DeltaE = round( DeltaE( Lab, Lab2 ), 4 ) # DeltaE is the pairwise color difference
comp$Munsell = dental$Munsell
comp$Munsell2 = MunsellNameFromHVC( HVC2, format='f', digits=2 )
comp$NickersonCD = round( NickersonColorDifference( HVC, HVC2 ), 4 )
comp
## Y L L2 Ldiff DeltaE Munsell Munsell2 NickersonCD
## B-96 37.05 67.34 67.3145 0.0255 0.0307 1.9Y 6.55/2.9 1.76Y 6.64/2.91 0.6942
## B-84 37.98 68.01 68.0059 0.0041 0.0603 0.9Y 6.65/3.2 0.78Y 6.71/3.21 0.5203
## B-85 38.24 68.23 68.1971 0.0329 0.0386 1.8Y 6.65/4.1 1.35Y 6.73/4.11 1.2253
## B-81 38.82 68.65 68.6207 0.0293 0.0348 1.5Y 6.60/2.8 1.55Y 6.77/2.81 1.1088
## B-95 41.22 70.36 70.3298 0.0302 0.0330 2.6Y 6.85/2.4 2.54Y 6.95/2.39 0.6664
## B-94 42.30 71.11 71.0773 0.0327 0.0381 3.0Y 6.95/2.7 3.01Y 7.02/2.71 0.4875
## B-69 42.49 71.24 71.2074 0.0326 0.0369 2.6Y 6.95/2.6 2.67Y 7.04/2.68 0.8349
## B-83 43.25 71.52 71.7243 -0.2043 0.2218 1.3Y 7.00/3.6 1.39Y 7.09/3.56 0.7828
## B-77 44.09 72.32 72.2886 0.0314 0.0352 2.3Y 7.05/2.8 2.30Y 7.15/2.87 0.7956
## B-93 45.01 72.93 72.8985 0.0315 0.0358 2.2Y 7.15/2.6 2.17Y 7.21/2.60 0.3964
## B-67 46.26 73.74 73.7139 0.0261 0.0301 2.5Y 7.20/3.2 2.71Y 7.29/3.21 0.8807
## B-55 47.10 74.28 74.2537 0.0263 0.0348 2.9Y 7.30/2.9 2.98Y 7.35/2.89 0.4359
## B-56 47.80 74.73 74.6986 0.0314 0.0346 2.0Y 7.30/2.9 2.11Y 7.40/3.01 1.0309
## B-92 48.67 75.28 75.2456 0.0344 0.0415 3.0Y 7.35/2.0 3.00Y 7.45/2.07 0.8203
## B-65 49.14 75.57 75.5383 0.0317 0.0392 1.1Y 7.30/3.1 1.24Y 7.48/3.18 1.5001
## B-54 49.15 75.58 75.5446 0.0354 0.0389 2.0Y 7.40/2.7 2.06Y 7.48/2.72 0.6206
## B-53 49.39 75.72 75.6933 0.0267 0.0327 2.1Y 7.40/2.5 2.05Y 7.50/2.51 0.6691
## B-91 49.57 75.84 75.8046 0.0354 0.0383 2.4Y 7.45/1.9 2.65Y 7.51/1.92 0.6083
## B-62 49.92 76.05 76.0201 0.0299 0.0333 3.1Y 7.45/2.3 2.97Y 7.53/2.25 0.7707
## B-63 50.00 76.10 76.0693 0.0307 0.0359 1.7Y 7.45/2.8 1.71Y 7.54/2.83 0.6376
## B-52 50.42 76.36 76.3263 0.0337 0.0397 3.6Y 7.50/2.1 3.69Y 7.56/2.27 0.9640
## B-66 51.21 76.84 76.8060 0.0340 0.0414 2.8Y 7.55/2.8 2.84Y 7.61/2.81 0.4563
## B-51 55.24 79.21 79.1793 0.0307 0.0388 3.2Y 7.80/2.2 3.24Y 7.86/2.18 0.4649
## B-59 55.72 79.49 79.4542 0.0358 0.0410 3.5Y 7.80/2.0 3.40Y 7.89/2.01 0.6493
The Lab agreement is good, but the published Lightness values are
consistently too large and the reason for this is unknown. The exception
is B-83 whose published Lightness=71.52 is too small and with the
largest DeltaE by far; it appears to be a transcription error.
The
Munsell agreement is not bad, but the pubished Munsell Value is too
small. This could be due to using magnesium oxide instead of the perfect
reflecting diffuser. We can test this by recomputing the value component
of HVC2
. The newly recomputed Munsell notation is denoted
Munsell3
.
HVC3 = HVC2
HVC3[ ,2] = VfromY( dental$Y, which='MgO' )
comp$Munsell2 = NULL
comp$NickersonCD = NULL
comp$Munsell3 = MunsellNameFromHVC( HVC3, format='f', digits=2 )
comp$NickersonCD = round( NickersonColorDifference( HVC, HVC3 ), 4 )
comp
## Y L L2 Ldiff DeltaE Munsell Munsell3 NickersonCD
## B-96 37.05 67.34 67.3145 0.0255 0.0307 1.9Y 6.55/2.9 1.76Y 6.56/2.91 0.2648
## B-84 37.98 68.01 68.0059 0.0041 0.0603 0.9Y 6.65/3.2 0.78Y 6.63/3.21 0.2693
## B-85 38.24 68.23 68.1971 0.0329 0.0386 1.8Y 6.65/4.1 1.35Y 6.65/4.11 0.7906
## B-81 38.82 68.65 68.6207 0.0293 0.0348 1.5Y 6.60/2.8 1.55Y 6.70/2.81 0.6716
## B-95 41.22 70.36 70.3298 0.0302 0.0330 2.6Y 6.85/2.4 2.54Y 6.87/2.39 0.2190
## B-94 42.30 71.11 71.0773 0.0327 0.0381 3.0Y 6.95/2.7 3.01Y 6.95/2.71 0.0722
## B-69 42.49 71.24 71.2074 0.0326 0.0369 2.6Y 6.95/2.6 2.67Y 6.96/2.68 0.3822
## B-83 43.25 71.52 71.7243 -0.2043 0.2218 1.3Y 7.00/3.6 1.39Y 7.01/3.56 0.3270
## B-77 44.09 72.32 72.2886 0.0314 0.0352 2.3Y 7.05/2.8 2.30Y 7.07/2.87 0.3366
## B-93 45.01 72.93 72.8985 0.0315 0.0358 2.2Y 7.15/2.6 2.17Y 7.13/2.60 0.1399
## B-67 46.26 73.74 73.7139 0.0261 0.0301 2.5Y 7.20/3.2 2.71Y 7.22/3.21 0.4132
## B-55 47.10 74.28 74.2537 0.0263 0.0348 2.9Y 7.30/2.9 2.98Y 7.27/2.89 0.3079
## B-56 47.80 74.73 74.6986 0.0314 0.0346 2.0Y 7.30/2.9 2.11Y 7.32/3.01 0.5578
## B-92 48.67 75.28 75.2456 0.0344 0.0415 3.0Y 7.35/2.0 3.00Y 7.37/2.07 0.3440
## B-65 49.14 75.57 75.5383 0.0317 0.0392 1.1Y 7.30/3.1 1.24Y 7.40/3.18 1.0222
## B-54 49.15 75.58 75.5446 0.0354 0.0389 2.0Y 7.40/2.7 2.06Y 7.40/2.72 0.1426
## B-53 49.39 75.72 75.6933 0.0267 0.0327 2.1Y 7.40/2.5 2.05Y 7.42/2.51 0.1903
## B-91 49.57 75.84 75.8046 0.0354 0.0383 2.4Y 7.45/1.9 2.65Y 7.43/1.92 0.3641
## B-62 49.92 76.05 76.0201 0.0299 0.0333 3.1Y 7.45/2.3 2.97Y 7.45/2.25 0.2900
## B-63 50.00 76.10 76.0693 0.0307 0.0359 1.7Y 7.45/2.8 1.71Y 7.46/2.83 0.1566
## B-52 50.42 76.36 76.3263 0.0337 0.0397 3.6Y 7.50/2.1 3.69Y 7.48/2.27 0.6744
## B-66 51.21 76.84 76.8060 0.0340 0.0414 2.8Y 7.55/2.8 2.84Y 7.53/2.81 0.1730
## B-51 55.24 79.21 79.1793 0.0307 0.0388 3.2Y 7.80/2.2 3.24Y 7.78/2.18 0.2416
## B-59 55.72 79.49 79.4542 0.0358 0.0410 3.5Y 7.80/2.0 3.40Y 7.81/2.01 0.1494
The Munsell Value agreement is now much better. The worst Nickerson
difference is for B-65 and this is largely because the published Munsell
Value is 7.30 instead of 7.40. Note that the Y values for B-65 and B-54
are almost identical and that the Munsell Value for B-54 is correct. So
again I think that the problem with B-65 is transcription error. For
Munsell Hue and Chroma the agreement is good. It must have been tedious
to use the graphical method for all 24 samples.
I thought it would be interesting to display the ISCC-NBS names for each of the 24 dental shades.
obj = data.frame( row.names=rownames(dental) )
obj$Munsell2 = MunsellNameFromHVC( HVC2, format='f', digits=2 )
block = ColorBlockFromMunsell( HVC2 )
obj[[ "ISCC-NBS Name" ]] = block$Name
obj
## Munsell2 ISCC-NBS Name
## B-96 1.76Y 6.64/2.91 grayish yellow
## B-84 0.78Y 6.71/3.21 light yellowish brown
## B-85 1.35Y 6.73/4.11 grayish yellow
## B-81 1.55Y 6.77/2.81 grayish yellow
## B-95 2.54Y 6.95/2.39 grayish yellow
## B-94 3.01Y 7.02/2.71 grayish yellow
## B-69 2.67Y 7.04/2.68 grayish yellow
## B-83 1.39Y 7.09/3.56 grayish yellow
## B-77 2.30Y 7.15/2.87 grayish yellow
## B-93 2.17Y 7.21/2.60 grayish yellow
## B-67 2.71Y 7.29/3.21 grayish yellow
## B-55 2.98Y 7.35/2.89 grayish yellow
## B-56 2.11Y 7.40/3.01 grayish yellow
## B-92 3.00Y 7.45/2.07 grayish yellow
## B-65 1.24Y 7.48/3.18 grayish yellow
## B-54 2.06Y 7.48/2.72 grayish yellow
## B-53 2.05Y 7.50/2.51 grayish yellow
## B-91 2.65Y 7.51/1.92 yellowish gray
## B-62 2.97Y 7.53/2.25 grayish yellow
## B-63 1.71Y 7.54/2.83 grayish yellow
## B-52 3.69Y 7.56/2.27 grayish yellow
## B-66 2.84Y 7.61/2.81 grayish yellow
## B-51 3.24Y 7.86/2.18 grayish yellow
## B-59 3.40Y 7.89/2.01 grayish yellow
All the dental shades are in the same block, except for 2. It would be interesting to turn this into a 3D scatterplot, with the color block boundaries displayed with transparency.
R version 4.4.2 (2024-10-31 ucrt) Platform: x86_64-w64-mingw32/x64 Running under: Windows 11 x64 (build 22631) Matrix products: default locale: [1] LC_COLLATE=C LC_CTYPE=English_United States.utf8 [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C [5] LC_TIME=English_United States.utf8 time zone: America/Los_Angeles tzcode source: internal attached base packages: [1] stats graphics grDevices utils datasets methods base other attached packages: [1] spacesXYZ_1.4-0 spacesRGB_1.7-0 munsellinterpol_3.1-0 loaded via a namespace (and not attached): [1] digest_0.6.37 R6_2.5.1 microbenchmark_1.5.0 fastmap_1.2.0 [5] xfun_0.49 glue_1.8.0 cachem_1.1.0 knitr_1.49 [9] htmltools_0.5.8.1 logger_0.4.0 rmarkdown_2.29 lifecycle_1.0.4 [13] cli_3.6.3 rootSolve_1.8.2.4 sass_0.4.9 jquerylib_0.1.4 [17] compiler_4.4.2 tools_4.4.2 evaluate_1.0.1 bslib_0.8.0 [21] yaml_2.3.10 rlang_1.1.4 jsonlite_1.8.9