R Under development (unstable) (2025-01-18 r87593 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
>
> # tests xyYtoMunsell() and MunsellToxyY() over special colors
>
> # tests sRGBtoMunsell() and MunsellTosRGB() over special colors
>
>
> library( munsellinterpol )
>
> options( width=144 )
>
> printf <- function( msg, ... )
+ {
+ mess = sprintf( msg[1], ... ) # should this really be msg[1] ?
+ cat( mess, '\n' ) #, file=stderr() )
+ }
>
> # returns time in seconds, from an arbitrary origin
> gettime <- function()
+ {
+ if( requireNamespace('microbenchmark') )
+ return( microbenchmark::get_nanotime() * 1.e-9 )
+ else
+ return( as.double( base::Sys.time() ) )
+ }
>
>
> testCentroids <- function()
+ {
+ # path = "../inst/extdata/Centrals_ISCC_NBS.txt"
+ path = system.file( "extdata/Centroids_ISCC-NBS.txt", package='munsellinterpol' )
+
+ df = read.table( path, header=T, sep='\t', stringsAsFactors=F )
+
+ printf( "----------- testCentroids() %d samples -----------------------", nrow(df) )
+
+ # printf( "Testing centroids..." )
+
+ # go forwards HVC -> xyY
+
+ HVC = HVCfromMunsellName( df$MunsellSpec )
+
+ time_start = gettime()
+
+ res = MunsellToxyY( HVC, warn=FALSE )
+
+ time_elapsed = gettime() - time_start
+
+ failures = sum( is.na(res$xyY[ ,1]) )
+
+ printf( "There were %d forward failures, out of %d samples. time=%g sec. %g/sample.",
+ failures, nrow(df), time_elapsed, time_elapsed/nrow(HVC) )
+
+
+ if( 0 < failures ) return(FALSE)
+
+ # now go backwards xyY -> HVC
+ time_start = gettime()
+
+ res = xyYtoMunsell( res$xyY, perf=TRUE )
+
+ time_elapsed = gettime() - time_start
+
+ failures = sum( is.na(res$HVC[ ,1]) )
+
+ printf( "There were %d reverse failures, out of %d samples. time=%g sec. %g/sample.",
+ failures, nrow(HVC), time_elapsed, time_elapsed/nrow(HVC) )
+
+ printf( "Performance:")
+ cat( "Time Elapsed 5-number summary: " )
+ cat( fivenum(res$time.elapsed,na.rm=T), '\n' )
+ cat( "Iterations 5-number summary: " )
+ cat( fivenum(res$iterations,na.rm=T), '\n' )
+ cat( "Evaluations 5-number summary: " )
+ cat( fivenum(res$evaluations,na.rm=T), '\n' )
+
+ # compare HVC and res$HVC
+ tol = 0.01
+ HVC.delta = abs(HVC - res$HVC)
+ HVC.delta[ ,1] = pmin( HVC.delta[ ,1], 100 - HVC.delta[ ,1] )
+ err = rowSums( HVC.delta )
+ idx = which.max( err )
+ df = data.frame( row.names=1 )
+ df$HVC = HVC[ idx, , drop=F ]
+ df$xyY = res$xyY[ idx, , drop=F ]
+ df$HVC.back = res$HVC[ idx, , drop=F ]
+ printf( "Maximum round-trip error = %g (tol=%g).", err[idx], tol )
+ print( df )
+
+ # how many exceeded the tolerance
+ count = sum( tol < err )
+ if( 0 < count )
+ printf( "%d round-trip errors exceeded %g.", count, tol )
+
+ if( 0 < failures || 0 < count ) return(FALSE)
+
+ return( TRUE )
+ }
>
>
> testOptimals <- function()
+ {
+ path = system.file( "extdata/OptimalColorsForIlluminantC.txt", package='munsellinterpol' )
+
+ df = read.table( path, header=T )
+
+ printf( "--------- testOptimals() %d samples -----------------------", nrow(df) )
+
+ xyY = as.matrix( df )
+
+ osname = Sys.info()[ 'sysname' ]
+ solaris = grepl( 'sun', osname, ignore.case=TRUE )
+
+ out = TRUE
+
+ for( hcinterp in c('bilin','bicub') )
+ {
+ for( vinterp in c('lin','cub') )
+ {
+ # go backwards xyY -> HVC
+ printf( "----- hcinterp='%s', vinterp='%s' -----", hcinterp, vinterp )
+
+ time_start = gettime()
+
+ res = xyYtoMunsell( xyY, warn=FALSE, perf=TRUE, hcinterp=hcinterp, vinterp=vinterp )
+
+ time_elapsed = gettime() - time_start
+
+ # print( res )
+ # return(FALSE)
+
+ HVC = res$HVC
+
+ mask = is.na( HVC[ ,1] )
+
+ failures = sum( mask )
+
+ printf( "testOptimals(). There were %d inversion failures, out of %d samples. time=%g sec. %g/sample. OS=%s",
+ failures, nrow(xyY), time_elapsed, time_elapsed/nrow(xyY), osname )
+
+ # in 2018, solaris started to give 5 iteration failures in CRAN testing
+ # in 2019 (R v 3.6.1), the same thing happened with fedora (both clang and gcc).
+ # So for safety in the future, just set limit to 5 !
+ limit = 5 # ifelse( solaris, 5, 0 ) # with solaris, 5 errors were detected in CRAN testing
+
+ if( limit < failures )
+ {
+ colnames(xyY) = c('x','y','Y')
+ colnames(HVC) = c('H','V','C')
+ df = data.frame( row.names=1:failures )
+ df$xyY = xyY[mask, , drop=FALSE]
+ df$HVC = HVC[mask, , drop=FALSE]
+ print( df )
+
+ #print( res )
+ out = FALSE
+ }
+
+ printf( "Performance:")
+ cat( "Time Elapsed 5-number summary: " )
+ cat( fivenum(res$time.elapsed,na.rm=T), '\n' )
+ cat( "Iterations 5-number summary: " )
+ cat( fivenum(res$iterations,na.rm=T), '\n' )
+ cat( "Evaluations 5-number summary: " )
+ cat( fivenum(res$evaluations,na.rm=T), '\n' )
+
+ if( max( res$iterations, na.rm=T ) == 100 )
+ {
+ idx = which( res$iterations == 100 ) # ; print(idx)
+ printf( "There were %d samples that failed to converge.", length(idx) )
+ df = res[ idx, , drop=FALSE ]
+ print(df)
+ }
+
+ if( out )
+ {
+ # do round-trip
+ xyY.back = MunsellToxyY( HVC, warn=FALSE, hcinterp=hcinterp, vinterp=vinterp )$xyY
+
+ delta = rowSums( abs(xyY - xyY.back) )
+
+ # ignore pure black
+ mask = xyY[ ,3]==0 & xyY.back[ ,3]==0
+ delta[mask] = 0
+
+ cat( "Round trip xyY -> HVC -> xyY inversion error 5-number summary: " )
+ cat( fivenum(delta), '\n' )
+
+ idx = which.max( delta )
+ df = data.frame( row.names=1 )
+ df$xyY = xyY[ idx, , drop=F ]
+ df$HVC = HVC[ idx, , drop=F ]
+ df$xyY.back = xyY.back[ idx, , drop=F ]
+ printf( "Maximum inversion error occurs for this one:" )
+ print( df )
+ }
+ }
+ }
+
+ return( out )
+ }
>
>
>
> testReals <- function()
+ {
+ df.real = subset( Munsell2xy, real==TRUE )
+
+ printf( "---------------- testReals() %d samples -----------------------", nrow(df.real) )
+
+ HVC = cbind( df.real$H, df.real$V, df.real$C )
+ xyY = cbind( df.real$x, df.real$y, YfromV(df.real$V) )
+
+ # go backwards xyY -> HVC
+ time_start = gettime()
+
+ res = xyYtoMunsell( xyY, warn=FALSE, perf=TRUE )
+
+ time_elapsed = gettime() - time_start
+
+ mask = is.na( res$HVC[ ,1] )
+
+ failures = sum( mask )
+
+ printf( "testReals(). There were %d inversion failures, out of %d samples. time=%g sec. %g/sample.",
+ failures, nrow(xyY), time_elapsed, time_elapsed/nrow(xyY) )
+
+
+ if( 0 < failures )
+ {
+ colnames(HVC) = c('H','V','C')
+ colnames(xyY) = c('x','y','Y')
+ df = data.frame( row.names=MunsellNameFromHVC( HVC[mask, ] ) )
+ df$HVC = HVC[mask, ]
+ df$xyY = xyY[mask, ]
+ print( df )
+ }
+
+ printf( "Performance:")
+ cat( "Time Elapsed 5-number summary: " )
+ cat( fivenum(res$time.elapsed,na.rm=T), '\n' )
+ cat( "Iterations 5-number summary: " )
+ cat( fivenum(res$iterations,na.rm=T), '\n' )
+ cat( "Evaluations 5-number summary: " )
+ cat( fivenum(res$evaluations,na.rm=T), '\n' )
+
+
+
+ # compare HVC and res$HVC
+ HVC.delta = abs(HVC - res$HVC)
+ HVC.delta[ ,1] = pmin( HVC.delta[ ,1], 100 - HVC.delta[ ,1] )
+ delta = rowSums( HVC.delta )
+ cat( "Round trip HVC -> xyY -> HVC inversion error 5-number summary: " )
+ cat( fivenum(delta), '\n' )
+ idx = which.max( delta )
+ df = data.frame( row.names=1 )
+ df$HVC = HVC[ idx, , drop=F ]
+ df$xyY = xyY[ idx, , drop=F ]
+ df$HVC.back = res$HVC[ idx, , drop=F ]
+ printf( "Maximum inversion error occurs for this one:" )
+ print( df )
+
+
+ return( failures == 0 )
+ }
>
>
> testNeutrals <- function()
+ {
+ # check that Chroma is small, and finite
+ RGB = matrix( 0:255, 256, 3 )
+ colnames(RGB) = c('R','G','B')
+
+ printf( "----------- testNeutrals() %d samples -----------------------", nrow(RGB) )
+
+ HVC = sRGBtoMunsell( RGB )
+
+ chroma = HVC[ ,3]
+ mask = is.na(chroma)
+ failures = sum(mask)
+ if( 0 < failures )
+ {
+ printf( "testNeutrals(). There were %d failures to convert.", failures )
+ df = data.frame( row.names=which(mask) )
+ df$RGB = RGB[mask, ]
+ print( df )
+ }
+
+ tol = 0 # 1.e-13 changed to 0 in v 3.0-0
+ mask = (is.finite(chroma) & tol < chroma)
+ count = sum( mask )
+ if( 0 < count )
+ {
+ printf( "testNeutrals(). There were %d chromas > %g.", count, tol )
+ df = data.frame( row.names=which(mask) )
+ df$RGB = RGB[mask, ]
+ df$Chroma = chroma[mask]
+ print( df )
+ }
+
+ # now go back
+ res = MunsellTosRGB( HVC )
+
+ RGB.delta = abs(RGB - res$RGB)
+ delta = rowSums( RGB.delta )
+ cat( "Round-trip error (RGB -> HVC -> RGB) 5-number summary: " )
+ cat( fivenum(delta), '\n' )
+
+ return( failures==0 && count==0 )
+ }
>
>
> testNearNeutrals <- function()
+ {
+ # check that Chroma is small, and finite
+ RGB = matrix( 0, 0, 3 )
+ colnames(RGB) = c('R','G','B')
+
+ for( k in 10:255 )
+ {
+ RGB = rbind( RGB, matrix(k,3,3) - diag(3) )
+ }
+
+ printf( "------- testNearNeutrals() %d samples -----------------------", nrow(RGB) )
+
+
+ HVC = sRGBtoMunsell( RGB )
+
+ chroma = HVC[ ,3]
+ mask = is.na(chroma)
+ failures = sum(mask)
+ if( 0 < failures )
+ {
+ printf( "testNearNeutrals(). There were %d failures to convert.", failures )
+ df = data.frame( row.names=which(mask) )
+ df$RGB = RGB[mask, ]
+ print( df )
+ return(FALSE)
+ }
+
+ tol = 0.30
+ mask = (is.finite(chroma) & tol < chroma)
+ count = sum( mask )
+ if( 0 < count )
+ {
+ printf( "testNearNeutrals(). There were %d chromas > %g.", count, tol )
+ df = data.frame( row.names=which(mask) )
+ df$RGB = RGB[mask, ]
+ df$Chroma = chroma[mask]
+ print( df )
+ return(FALSE)
+ }
+
+
+ # now go back
+ res = MunsellTosRGB( HVC )
+ RGB.delta = abs(RGB - res$RGB)
+ delta = rowSums( RGB.delta )
+ cat( "Round-trip error (RGB->HVC->RGB) 5-number summary: " )
+ cat( fivenum(delta), '\n' )
+
+ tol = 0.005
+ if( tol < max(delta) )
+ {
+ printf( "Maximum round-trip error = %g > %g.", max(delta), tol )
+ return(FALSE)
+ }
+
+ return( TRUE )
+ }
>
> testDarks <- function()
+ {
+ rgbmax = 8 # 10 # 5
+
+ RGB = as.matrix( expand.grid( R=0:rgbmax, G=0:rgbmax, B=0:rgbmax ) )
+
+ printf( "--------------------- testDarks() %d samples -----------------------", nrow(RGB) )
+
+ HVC = sRGBtoMunsell( RGB )
+
+ chroma = HVC[ ,3]
+ mask = is.na(chroma)
+ failures = sum(mask)
+ if( 0 < failures )
+ {
+ printf( "testDarks(). There were %d failures to convert.", failures )
+ df = data.frame( row.names=which(mask) )
+ df$RGB = RGB[mask, , drop=FALSE ]
+ print( df )
+ return(FALSE)
+ }
+
+ # now go back
+ res = MunsellTosRGB( HVC )
+ RGB.delta = abs(RGB - res$RGB)
+ delta = rowSums( RGB.delta )
+ cat( "Round-trip error (RGB->HVC->RGB) 5-number summary: " )
+ cat( fivenum(delta), '\n' )
+
+ return( failures==0 )
+ }
>
>
> {
+ x = gettime() # load microbenchmark
+
+
+ if( testCentroids() )
+ printf( "testCentroids() passed." )
+ else
+ stop( "testCentroids() failed !", call.=FALSE )
+
+
+ if( testNeutrals() )
+ printf( "testNeutrals() passed." )
+ else
+ stop( "testNeutrals() failed !", call.=FALSE )
+
+ if( testNearNeutrals() )
+ printf( "testNearNeutrals() passed." )
+ else
+ stop( "testNearNeutrals() failed !", call.=FALSE )
+
+ if( testDarks() )
+ printf( "testDarks() passed." )
+ else
+ stop( "testDarks() failed !", call.=FALSE )
+
+ if( testReals() )
+ printf( "testReals() passed." )
+ else
+ stop( "testReals() failed !", call.=FALSE )
+
+ if( testOptimals() )
+ printf( "testOptimals() passed." )
+ else
+ stop( "testOptimals() failed !", call.=FALSE )
+
+
+
+ printf( "Passed all Munsell Transforms tests !" )
+ }
----------- testCentroids() 267 samples -----------------------
There were 0 forward failures, out of 267 samples. time=0.143359 sec. 0.000536927/sample.
There were 0 reverse failures, out of 267 samples. time=1.02493 sec. 0.00383871/sample.
Performance:
Time Elapsed 5-number summary: 5.200505e-06 0.0032144 0.003622 0.004146249 0.0283292
Iterations 5-number summary: 2 3 3 4 5
Evaluations 5-number summary: 8 11 11 14 17
Maximum round-trip error = 0.00728479 (tol=0.01).
HVC.H HVC.V HVC.C xyY.x xyY.y xyY.Y HVC.back.H HVC.back.V HVC.back.C
1 23.00 5.50 0.06 0.3112943 0.3174985 23.9680791 23.00726754 5.50000000 0.05998275
testCentroids() passed.
----------- testNeutrals() 256 samples -----------------------
Round-trip error (RGB -> HVC -> RGB) 5-number summary: 0 1.958787e-08 4.648795e-08 7.315473e-08 1.73029e-07
testNeutrals() passed.
------- testNearNeutrals() 738 samples -----------------------
Round-trip error (RGB->HVC->RGB) 5-number summary: 8.470828e-09 5.922419e-06 4.008284e-05 0.0001609282 0.002403704
testNearNeutrals() passed.
--------------------- testDarks() 729 samples -----------------------
Round-trip error (RGB->HVC->RGB) 5-number summary: 0 1.615927e-07 5.110979e-07 4.897153e-06 0.0001205296
testDarks() passed.
---------------- testReals() 3089 samples -----------------------
testReals(). There were 0 inversion failures, out of 3089 samples. time=8.96168 sec. 0.00290116/sample.
Performance:
Time Elapsed 5-number summary: 0.0018255 0.0023889 0.0029104 0.0029903 0.0307802
Iterations 5-number summary: 2 3 4 4 7
Evaluations 5-number summary: 8 11 14 14 23
Round trip HVC -> xyY -> HVC inversion error 5-number summary: 5.892797e-11 5.333471e-08 1.86361e-06 2.367377e-05 0.0008028285
Maximum inversion error occurs for this one:
HVC.1 HVC.2 HVC.3 xyY.1 xyY.2 xyY.3 HVC.back.H HVC.back.V HVC.back.C
1 60 9 2 0.29070 0.31590 76.69559 60.000798 9.000000 2.000005
testReals() passed.
--------- testOptimals() 994 samples -----------------------
----- hcinterp='bilin', vinterp='lin' -----
testOptimals(). There were 0 inversion failures, out of 994 samples. time=3.96703 sec. 0.00399098/sample. OS=Windows
Performance:
Time Elapsed 5-number summary: 1.069997e-05 0.003324499 0.00381275 0.004245199 0.0353326
Iterations 5-number summary: 2 3 3 4 5
Evaluations 5-number summary: 8 11 11 14 17
Round trip xyY -> HVC -> xyY inversion error 5-number summary: 0 5.018656e-09 1.970463e-08 1.486058e-07 2.053347e-06
Maximum inversion error occurs for this one:
xyY.x xyY.y xyY.Y HVC.H HVC.V HVC.C xyY.back.x xyY.back.y xyY.back.Y
1 0.19586 0.10683 17.81000 79.475725 4.829257 24.347855 0.1958589 0.1068290 17.8100000
----- hcinterp='bilin', vinterp='cub' -----
Error in iH:(iH + 1) : NA/NaN argument
Error in iH:(iH + 1) : NA/NaN argument
Error in iH:(iH + 1) : NA/NaN argument
Error in iH:(iH + 1) : NA/NaN argument
Error in iH:(iH + 1) : NA/NaN argument
testOptimals(). There were 5 inversion failures, out of 994 samples. time=4.85741 sec. 0.00488673/sample. OS=Windows
Performance:
Time Elapsed 5-number summary: 9.699725e-06 0.0039034 0.004631801 0.0049986 0.0818039
Iterations 5-number summary: 2 3 3 4 6
Evaluations 5-number summary: 8 11 11 14 20
Round trip xyY -> HVC -> xyY inversion error 5-number summary: 0 5.184237e-09 1.808143e-08 1.4736e-07 2.017029e-06
Maximum inversion error occurs for this one:
xyY.x xyY.y xyY.Y HVC.H HVC.V HVC.C xyY.back.x xyY.back.y xyY.back.Y
1 0.24813 0.06337 8.55260 84.424134 3.457032 34.260334 0.24812887 0.06337088 8.55260000
----- hcinterp='bicub', vinterp='lin' -----
testOptimals(). There were 0 inversion failures, out of 994 samples. time=4.97 sec. 0.005/sample. OS=Windows
Performance:
Time Elapsed 5-number summary: 1.010019e-05 0.004061501 0.00454315 0.005363599 0.0435314
Iterations 5-number summary: 2 3 4 4 6
Evaluations 5-number summary: 8 11 14 14 20
Round trip xyY -> HVC -> xyY inversion error 5-number summary: 0 5.598911e-09 2.052519e-08 1.851469e-07 2.226422e-06
Maximum inversion error occurs for this one:
xyY.x xyY.y xyY.Y HVC.H HVC.V HVC.C xyY.back.x xyY.back.y xyY.back.Y
1 0.301670 0.081802 8.746800 87.960039 3.494055 31.490646 0.30166890 0.08180088 8.74680001
----- hcinterp='bicub', vinterp='cub' -----
Error in max(iH - 1, 1):min(iH + 2, length(H.vector)) : NA/NaN argument
Error in max(iH - 1, 1):min(iH + 2, length(H.vector)) : NA/NaN argument
Error in max(iH - 1, 1):min(iH + 2, length(H.vector)) : NA/NaN argument
Error in max(iH - 1, 1):min(iH + 2, length(H.vector)) : NA/NaN argument
Error in max(iH - 1, 1):min(iH + 2, length(H.vector)) : NA/NaN argument
testOptimals(). There were 5 inversion failures, out of 994 samples. time=4.57192 sec. 0.00459951/sample. OS=Windows
Performance:
Time Elapsed 5-number summary: 1.639966e-05 0.0036645 0.0041761 0.0050576 0.0153951
Iterations 5-number summary: 2 3 4 4 7
Evaluations 5-number summary: 8 11 14 14 23
Round trip xyY -> HVC -> xyY inversion error 5-number summary: 0 5.594705e-09 1.974002e-08 1.718229e-07 1.953349e-06
Maximum inversion error occurs for this one:
xyY.x xyY.y xyY.Y HVC.H HVC.V HVC.C xyY.back.x xyY.back.y xyY.back.Y
1 0.47928 0.51513 77.45300 25.839890 9.035888 20.333109 0.479281 0.515131 77.453000
testOptimals() passed.
Passed all Munsell Transforms tests !
>
> proc.time()
user system elapsed
38.79 0.23 39.03