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. > > library( munsellinterpol ) > > printf <- function( msg, ... ) + { + mess = sprintf( msg[1], ... ) # should this really be msg[1] ? + cat( mess, '\n' ) #, file=stderr() ) + } > > testInversion <- function() + { + # round trip V -> Y -> V + Vvec = seq( 0, 10, len=10001 ) + + for( w in c( 'ASTM', 'OSA', 'MGO' ) ) + { + Vtest = VfromY( YfromV(Vvec,w), w ) + + ran = range( Vvec - Vtest ) + printf( "V with '%s', inversion range = [%g,%g]", w, ran[1], ran[2] ) + + if( ! identical( round(Vvec,8), round(Vtest,8) ) ) + return(FALSE) + } + + # round trip Y -> V -> Y + Yvec = seq( 0, 100, len=10001 ) + + for( w in c( 'ASTM', 'OSA', 'MGO' ) ) + { + Ytest = YfromV( VfromY(Yvec,w), w ) + + ran = range( Yvec - Ytest ) + printf( "Y with '%s', inversion range = [%g,%g]", w, ran[1], ran[2] ) + + if( ! identical( round(Yvec,7), round(Ytest,7) ) ) + return(FALSE) + } + + return(TRUE) + } > > testYfromV <- function() + { + # these 2 vectors, Value and LuminanceFactor, are taken from munsellinterpol.R, by Jose Gama + # which in turn were taken from LuminanceFactorToMunsellValue.m, by Paul Centore + Value = seq(0,10,0.02) + LuminanceFactor <- c(0.000000,0.023740,0.047310,0.070723,0.093989,0.117118,0.140123,0.163012,0.185799, + 0.208492,0.231102,0.253641,0.276118,0.298543,0.320928,0.343281,0.365614,0.387936, + 0.410257,0.432587,0.454936,0.477314,0.499730,0.522194,0.544715,0.567303,0.589967, + 0.612717,0.635561,0.658509,0.681571,0.704754,0.728068,0.751522,0.775125,0.798885, + 0.822812,0.846913,0.871197,0.895673,0.920349,0.945234,0.970336,0.995662,1.021222, + 1.047023,1.073073,1.099381,1.125954,1.152799,1.179925,1.207340,1.235051,1.263065, + 1.291391,1.320035,1.349005,1.378308,1.407952,1.437944,1.468291,1.498999,1.530077, + 1.561531,1.593367,1.625594,1.658217,1.691243,1.724679,1.758532,1.792808,1.827513, + 1.862655,1.898239,1.934272,1.970759,2.007709,2.045125,2.083016,2.121386,2.160241, + 2.199588,2.239433,2.279781,2.320638,2.362010,2.403902,2.446321,2.489271,2.532759, + 2.576790,2.621368,2.666500,2.712192,2.758447,2.805272,2.852671,2.900650,2.949214, + 2.998368,3.048116,3.098465,3.149418,3.200980,3.253157,3.305953,3.359373,3.413421, + 3.468102,3.523421,3.579382,3.635990,3.693248,3.751163,3.809737,3.868975,3.928881, + 3.989460,4.050716,4.112653,4.175275,4.238586,4.302590,4.367291,4.432693,4.498800, + 4.565616,4.633144,4.701389,4.770353,4.840042,4.910458,4.981605,5.053487,5.126107, + 5.199468,5.273575,5.348431,5.424038,5.500401,5.577523,5.655406,5.734055,5.813473, + 5.893662,5.974626,6.056368,6.138891,6.222198,6.306293,6.391178,6.476856,6.563330, + 6.650603,6.738677,6.827557,6.917244,7.007741,7.099052,7.191178,7.284123,7.377889, + 7.472478,7.567894,7.664139,7.761215,7.859126,7.957873,8.057459,8.157887,8.259158, + 8.361276,8.464242,8.568059,8.672730,8.778256,8.884640,8.991885,9.099991,9.208963, + 9.318801,9.429508,9.541086,9.653537,9.766863,9.881067,9.996150,10.112115,10.228963, + 10.346696,10.465317,10.584827,10.705228,10.826523,10.948712,11.071799,11.195785, + 11.320671,11.446459,11.573152,11.700751,11.829258,11.958675,12.089003,12.220244, + 12.352400,12.485472,12.619463,12.754374,12.890206,13.026961,13.164642,13.303248, + 13.442783,13.583248,13.724643,13.866972,14.010235,14.154434,14.299571,14.445646, + 14.592662,14.740620,14.889522,15.039369,15.190162,15.341904,15.494595,15.648237, + 15.802831,15.958379,16.114883,16.272343,16.430761,16.590140,16.750479,16.911780, + 17.074046,17.237277,17.401474,17.566640,17.732774,17.899880,18.067958,18.237010, + 18.407037,18.578040,18.750021,18.922981,19.096921,19.271844,19.447749,19.624640, + 19.802516,19.981380,20.161233,20.342076,20.523910,20.706737,20.890559,21.075377, + 21.261191,21.448004,21.635817,21.824631,22.014448,22.205269,22.397096,22.589929, + 22.783771,22.978623,23.174486,23.371361,23.569251,23.768157,23.968079,24.169020, + 24.370981,24.573964,24.777969,24.982999,25.189055,25.396139,25.604251,25.813394, + 26.023570,26.234779,26.447023,26.660305,26.874624,27.089984,27.306386,27.523831, + 27.742321,27.961858,28.182443,28.404078,28.626765,28.850505,29.075300,29.301153, + 29.528064,29.756035,29.985069,30.215167,30.446331,30.678562,30.911863,31.146236, + 31.381682,31.618204,31.855802,32.094480,32.334239,32.575081,32.817008,33.060023, + 33.304126,33.549321,33.795610,34.042994,34.291476,34.541057,34.791741,35.043528, + 35.296423,35.550425,35.805539,36.061766,36.319109,36.577570,36.837151,37.097854, + 37.359683,37.622640,37.886726,38.151945,38.418299,38.685791,38.954422,39.224197, + 39.495117,39.767186,40.040405,40.314777,40.590306,40.866994,41.144844,41.423859, + 41.704041,41.985394,42.267920,42.551623,42.836505,43.122569,43.409819,43.698257, + 43.987888,44.278713,44.570736,44.863961,45.158390,45.454027,45.750875,46.048938, + 46.348219,46.648721,46.950448,47.253403,47.557591,47.863014,48.169676,48.477581, + 48.786732,49.097134,49.408790,49.721704,50.035879,50.351320,50.668031,50.986015, + 51.305276,51.625820,51.947649,52.270767,52.595180,52.920891,53.247904,53.576225, + 53.905856,54.236803,54.569070,54.902662,55.237582,55.573836,55.911428,56.250364, + 56.590646,56.932281,57.275273,57.619628,57.965348,58.312441,58.660911,59.010762, + 59.362000,59.714631,60.068658,60.424088,60.780926,61.139177,61.498846,61.859939, + 62.222462,62.586419,62.951817,63.318661,63.686957,64.056710,64.427926,64.800612, + 65.174773,65.550415,65.927544,66.306166,66.686287,67.067913,67.451051,67.835707, + 68.221887,68.609598,68.998846,69.389637,69.781979,70.175877,70.571338,70.968370, + 71.366978,71.767171,72.168954,72.572334,72.977319,73.383917,73.792132,74.201974, + 74.613450,75.026566,75.441330,75.857750,76.275833,76.695586,77.117018,77.540136, + 77.964947,78.391460,78.819682,79.249622,79.681288,80.114687,80.549827,80.986718, + 81.425366,81.865781,82.307971,82.751945,83.197711,83.645277,84.094652,84.545845, + 84.998866,85.453722,85.910422,86.368977,86.829394,87.291683,87.755853,88.221914, + 88.689875,89.159745,89.631535,90.105252,90.580908,91.058511,91.538072,92.019601, + 92.503107,92.988601,93.476093,93.965592,94.457109,94.950655,95.446239,95.943873, + 96.443567,96.945331,97.449176,97.955113,98.463153,98.973307,99.485586,100.000000) + + + ## ASTM test ## + printf( "Testing YfromV(*,which='%s') on %d Values.", 'astm', length(Value) ) + + Y.astm = YfromV( Value, which='astm' ) + + delta = max( abs(Y.astm - LuminanceFactor) ) + printf( "For ASTM quintic, max( abs(Y.astm - LuminanceFactor) ) = %g\n", delta ) + + bytes.LD = .Machine$sizeof.longdouble + + bytes.LD = 0 # force test using all.equal(), and not identical() which is too strict. v 2.6-1 2020-02-01 + + if( 0 < bytes.LD ) + # strict test (formerly the usual case) + ok = identical( round(Y.astm,6), LuminanceFactor ) + else + # less strict test + ok = isTRUE( all.equal( Y.astm, LuminanceFactor, tolerance = 1.e-5 ) ) # next time try 1.e-6, or maybe even 6.e-7 + + if( ! ok ) + { + printf( "Test of ASTM quintic failed, on test of %d Values. bytes.LD=%d", + length(Value), bytes.LD ) + return(FALSE) + } + + + ## Newhall test ## + printf( "Testing YfromV(*,which='%s') on %d Values", 'OSA', length(Value) ) + + Y.newhall = YfromV( Value, which='OSA' ) + + diff = Y.astm - Y.newhall + ran = range( diff ) #; print(ran) + + #idx = which.max( abs(diff) ) + #cat( Value[idx], Y.astm[idx], Y.newhall[idx], '\n' ) + + ok = max(abs(ran)) < 0.001 + if( ! ok ) + { + printf( "Test of OSA quintic failed, on test of %d Values.", length(Value) ) + return(FALSE) + } + + ## MgO test ## + + # these 2 vectors, Value and LuminanceFactor, are taken NBS publications + Value = seq(0,10,by=1) + LuminanceFactor <- c(0,1.210,3.126,6.555,12.001,19.766,30.053,43.063,59.099,78.665,102.568) + + Y.mgo = YfromV( Value, which='mgo' ) + + printf( "Testing YfromV(*,which='%s') on %d Values", 'MgO', length(Value) ) + + ok = identical( round(Y.mgo,3), LuminanceFactor ) + if( ! ok ) + { + printf( "testYfromV(). Test of MgO quintic failed, on test of %d Values.", length(Value) ) + return(FALSE) + } + + return(TRUE) + } > > > if( ! testInversion() ) stop( "testInversion() failed !", call.=FALSE ) V with 'ASTM', inversion range = [-3.20541e-09,2.92856e-09] V with 'OSA', inversion range = [-3.20572e-09,2.92881e-09] V with 'MGO', inversion range = [-3.20572e-09,2.92881e-09] Y with 'ASTM', inversion range = [-2.63669e-08,3.24457e-09] Y with 'OSA', inversion range = [-2.63708e-08,3.24034e-09] Y with 'MGO', inversion range = [-2.14331e-08,3.52456e-09] > > if( ! testYfromV() ) stop( "testYfromV() failed !", call.=FALSE ) Testing YfromV(*,which='astm') on 501 Values. For ASTM quintic, max( abs(Y.astm - LuminanceFactor) ) = 4.98458e-07 Testing YfromV(*,which='OSA') on 501 Values Testing YfromV(*,which='MgO') on 11 Values > > printf( "Passed all VandY tests !" ) Passed all VandY tests ! > > proc.time() user system elapsed 0.31 0.06 0.36