R Under development (unstable) (2025-02-08 r87709 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( spacesXYZ ) Attaching spacesXYZ. Version: 1.5-0. Author: Glenn Davis [aut, cre]. Built: R 4.5.0; ; 2025-02-09 23:05:20 UTC; windows > > options( width=144 ) > > printf <- function( msg, ... ) + { + mess = sprintf( msg[1], ... ) # should this really be msg[1] ? + cat( mess, '\n' ) #, file=stderr() ) + } > > > # temperature -> uv -> CCT should have a small difference > > testRoundtrips.uv <- function( locus='robertson' ) + { + printf( "\n--------------------- testRoundtrips.uv('%s') -----------------------", locus ) + + # mat = matrix( c('robertson','robertson', 'mccamy','mccamy', 'native','native' ), 3, 2, byrow=TRUE ) + strict = TRUE + + for( iso in c('robertson', 'mccamy','native' ) ) + { + if( iso == 'mccamy' ) + # 1710 is about as low as McCamy can go + temperature = c( 1710, seq(2000,33000,by=1000) ) + else + temperature = c( 1667, seq(2000,33000,by=1000), 75000, Inf ) + + uv = planckLocus( temperature, locus=locus, param=iso ) + if( any( is.na(uv) ) ) + { + printf( "planckLocus() failed for param='%s'. It returned some NAs", iso ) + print( uv ) + return(FALSE) + } + + CCTback = CCTfromuv( uv, isotherm=iso, locus=locus, strict=strict ) + if( any( is.na(CCTback) ) ) + { + printf( "CCTfromuv() failed for isotherm='%s'. It returned some NAs", iso ) + return(FALSE) + } + + delta = CCTback - temperature #; print(delta) + + # NaNs may come from Inf-Inf, so change them to 0s + delta[ is.nan(delta) ] = 0 + + #printf( "testRoundtrips.uv() param='%s' max(abs(delta))=%g", iso, max(abs(delta) ) ) + + tol = ifelse( iso=='native', 5.e-5, 5.e-2 ) + + if( tol < max(abs(delta)) ) + { + printf( "testRoundtrips.uv(). Round-trip failed for param='%s' and isotherm='%s'. max(abs(delta))=%g", + iso, iso, max(abs(delta)) ) + print(delta) + return(FALSE) + } + } + + printf( "testRoundtrips.uv('%s') passed.", locus ) + + return( TRUE ) + } > > > > > # temperature -> xy -> CCT should have a small difference > > testRoundtrips.xy <- function() + { + printf( "\n--------------------- testRoundtrips.xy() -----------------------" ) + + + strict = TRUE + + for( iso in c('robertson', 'mccamy','native' ) ) + { + if( iso == 'mccamy' ) + # 1710 is about as low as McCamy can go + temperature = c( 1710, seq(2000,33000,by=1000) ) + else + temperature = c( 1677, seq(2000,33000,by=1000), 75000, Inf ) + + xy = planckLocus( temperature, param=iso, space=1931 ) + if( any( is.na(xy) ) ) + { + printf( "xyfromTemperature() failed for param='%s'. It returned some NAs", iso ) + return(FALSE) + } + + CCTback = CCTfromxy( xy, isotherm=iso, strict=strict ) + if( any( is.na(CCTback) ) ) + { + printf( "CCTfromxy() failed for isotherm='%s'. It returned some NAs", iso ) + return(FALSE) + } + + delta = CCTback - temperature #; print(delta) + + # NaNs may come from Inf-Inf, so change them to 0s + delta[ is.nan(delta) ] = 0 + + + #printf( "testRoundtrips.xy() param='%s' max(abs(delta))=%g", iso, max(abs(delta) ) ) + + tol = ifelse( iso=='native', 5.e-5, 5.e-2 ) + + if( tol < max(abs(delta)) ) + { + printf( "testRoundtrips.xy(). Round-trip failed for param='%s' and isotherm='%s'. max(abs(delta))=%g", + iso, iso, max(abs(delta)) ) + print(delta) + return(FALSE) + } + } + + printf( "testRoundtrips.xy() passed." ) + + return( TRUE ) + } > > > testStrictness <- function( locus='robertson' ) + { + printf( "\n--------------------- testStrictness('%s') -----------------------", locus ) + + temperaturetest = c( 1800, seq(2000,33000,by=1000) ) + + for( delta in c(-0.051,0.051) ) # above and below + { + # make some uv points just outside the valid band above the locus. Though some will be outside the chromaticity diagram ! + uvoutside = planckLocus( temperaturetest, locus, param='native', Duv=delta ) # Duv + + #printf( "delta=%g", delta ) + #print( uvoutside ) + + for( isotherm in c('mccamy','robertson','native') ) + { + # first test with strict=FALSE, all should succeed. + CCT = CCTfromuv( uvoutside, isotherm=isotherm, locus=locus, strict=FALSE ) + + #print( CCT ) + + count = sum( is.na(CCT) ) + if( 0 < count ) + { + printf( "strict=FALSE test failed for %d of %d points too far from the locus. delta=%g", + count, length(CCT), delta ) + + return(FALSE) + } + + # now test with strict=TRUE, all should fail. + CCT = CCTfromuv( uvoutside, isotherm=isotherm, locus=locus, strict=TRUE ) + + #print( CCT ) + + count = sum( ! is.na(CCT) ) + if( 0 < count ) + { + printf( "strict=TRUE test failed for %d of %d points too far from the '%s' locus. delta=%g", + count, length(CCT), locus, delta ) + return(FALSE) + } + } + + } + + printf( "testStrictness('%s') passed.", locus ) + + return(TRUE) + } > > > > > if( ! testRoundtrips.uv('robertson') ) stop( "testRoundtrips.uv('robertson') failed !", call.=FALSE ) --------------------- testRoundtrips.uv('robertson') ----------------------- testRoundtrips.uv('robertson') passed. > > if( ! testRoundtrips.uv('precision') ) stop( "testRoundtrips.uv('precision') failed !", call.=FALSE ) --------------------- testRoundtrips.uv('precision') ----------------------- testRoundtrips.uv('precision') passed. > > if( ! testRoundtrips.xy() ) stop( "testRoundtrips.xy() failed !", call.=FALSE ) --------------------- testRoundtrips.xy() ----------------------- testRoundtrips.xy() passed. > > > if( ! testStrictness('precision') ) stop( "testStrictness('precision') failed !", call.=FALSE ) --------------------- testStrictness('precision') ----------------------- testStrictness('precision') passed. > > if( ! testStrictness('robertson') ) stop( "testStrictness('robertson') failed !", call.=FALSE ) # this one started to fail in Feb 2025, invest later --------------------- testStrictness('robertson') ----------------------- WARN [2025-02-10 00:05:57] spacesXYZ::nativeFromMcCamy(). CCT=1639.31. Test function has the same sign at endpoints [0,600]. -0.167827 and -0.0204885. Intersection of isotherm and locus cannot be calculated. WARN [2025-02-10 00:05:57] spacesXYZ::nativeFromMcCamy(). CCT=1639.31. Test function has the same sign at endpoints [0,600]. -0.167827 and -0.0204885. Intersection of isotherm and locus cannot be calculated. testStrictness('robertson') passed. > > > printf( "\nPassed all CCT tests !" ) Passed all CCT tests ! > > proc.time() user system elapsed 0.67 0.04 0.71