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.
= system.file( 'extdata/dental.txt', package='munsellinterpol' )
path = read.table( path, header=TRUE, sep='\t', stringsAsFactors=FALSE )
dental 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.
= as.matrix( dental[ c('x','y','Y') ] )
xyY = XYZfromxyY( xyY ) / 100
XYZ # adapt from Illuminant C to the whitepoint of sRGB, which is D65
# make the Chromatic Adaptation Transform
= spacesXYZ::CAT( 'C', getWhiteXYZ('sRGB',which='display') )
theCAT = adaptXYZ( theCAT, XYZ )
XYZ # create data.frame obj for plotting
= 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
objrownames(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.
= as.matrix( dental[ c('L','a','b') ] )
Lab = XYZfromxyY( xyY )
XYZ = LabfromXYZ( XYZ/100, 'C' ) # recompute Lab
Lab2 = HVCfromMunsellName( dental$Munsell )
HVC = XYZtoMunsell( XYZ ) # recompute Munsell HVC
HVC2 = 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 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
.
= HVC2
HVC3 2] = VfromY( dental$Y, which='MgO' )
HVC3[ ,$Munsell2 = NULL
comp$NickersonCD = NULL
comp$Munsell3 = MunsellNameFromHVC( HVC3, format='f', digits=2 )
comp$NickersonCD = round( NickersonColorDifference( HVC, HVC3 ), 4 )
comp 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.
= data.frame( row.names=rownames(dental) )
obj $Munsell2 = MunsellNameFromHVC( HVC2, format='f', digits=2 )
obj= ColorBlockFromMunsell( HVC2 )
block "ISCC-NBS Name" ]] = block$Name
obj[[ 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.1.3 (2022-03-10) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19044) Matrix products: default locale: [1] LC_COLLATE=C LC_CTYPE=English_United States.1252 [3] LC_MONETARY=English_United States.1252 LC_NUMERIC=C [5] LC_TIME=English_United States.1252 attached base packages: [1] stats graphics grDevices utils datasets methods base other attached packages: [1] spacesXYZ_1.2-1 spacesRGB_1.5-0 munsellinterpol_3.0-0 loaded via a namespace (and not attached): [1] digest_0.6.28 magrittr_2.0.1 evaluate_0.14 rootSolve_1.8.2.3 [5] highr_0.9 rlang_0.4.12 stringi_1.7.5 rmarkdown_2.11 [9] tools_4.1.3 stringr_1.4.0 xfun_0.28 yaml_2.2.1 [13] fastmap_1.1.0 compiler_4.1.3 microbenchmark_1.4.9 htmltools_0.5.2 [17] knitr_1.37