R Under development (unstable) (2024-01-23 r85822 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 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( spacesRGB )
> 
> 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() ) )
+     }
>     
>     
> testRGB <- function()
+     {
+     printf( "---------------------  testRGB()  -----------------------" )
+         
+     #   make an ACES space
+     #theOETF     = general.RRT( redmod='1.1+pinv' )  *  general.PODT( REC709_PRI, Ymax=100, surround='dim' )  *  sRGB.EOTF^-1 
+     #theEOTF     = sRGB.EOTF 
+     #ok  = installRGB( 'test-ACES', scene=AP0_PRI, OETF=theOETF, EOTF=theEOTF )
+     #if( ! ok )  return(FALSE)
+         
+         
+     # make random signal RGBs   
+     set.seed(0)    
+     count   = 100000
+     
+     RGB         = matrix( runif(3*count,max=255), ncol=3 )
+     rownames(RGB)   = sprintf( "%04d", 1:count )
+     colnames(RGB)   = c('R','G','B')
+             
+     data.space    = summaryRGB( 1 )
+     
+     if( nrow(data.space) == 0 )
+         {
+         printf(  "No RGB spaces are installed !" )    
+         return(FALSE)
+         }
+         
+     
+     for( k in 1:nrow(data.space) )
+         {
+         space   = rownames(data.space)[k]
+         
+         for( which in c('scene','display') )
+             {
+             time_start      = gettime()
+ 
+             df              = XYZfromRGB( RGB, space=space, which=which, max=255 )
+             if( any(df$OutOfGamut) )
+                 {
+                 printf(  "For space %s, in XYZfromRGB(), %d of %d RGBs were flagged as out-of-gamut.",
+                                 space, sum(df$OutOfGamut), length(df$OutOfGamut) )
+                 return(FALSE)
+                 }        
+ 
+             XYZ             = df$XYZ    
+             RGB.back        = RGBfromXYZ( XYZ, space=space, which=which, max=255 )$RGB      #; print( 'RGB OK' )
+             
+             time_elapsed    = gettime() - time_start
+             
+             delta   = rowSums( abs(RGB - RGB.back) )  
+             
+             printf( "%-11s  RGB ->  %7s XYZ -> RGB    max(delta)=%g   %d samples at %g sec/sample", 
+                                 space, which, max(delta), count, time_elapsed/count )
+              
+             if( which == 'scene' )
+                 {
+                 OETF   = data.space$OETF[k]
+                 tol = ifelse( grepl('~',OETF), 5.e-12, 5.e-6 )    # pure gamma gives problems near 0 !  If not ATLAS, then 5.e-7 is OK
+                 }
+             else
+                 {
+                 EOTF   = data.space$EOTF[k]
+                 tol = ifelse( grepl('~',EOTF), 5.e-12, 5.e-6 )    # pure gamma gives problems near 0 !  If not ATLAS, then 5.e-7 is OK
+                 }
+             
+             failures = sum( tol < delta )   
+             if( 0 < failures )
+                 {
+                 idx = which.max(delta)        
+                 printf(  "There were %d  %s -> XYZ -> %s failures.  Max error = %g > %g",
+                             failures, space, space, delta[idx], tol )
+ 
+                 df  = data.frame( row.names=1 )
+                 df$RGB          = RGB[idx, ,drop=FALSE]
+                 df$XYZ          = XYZ[idx, ,drop=FALSE]
+                 df$RGB.back     = RGB.back[idx, ,drop=FALSE]        
+                 print( df )
+                 
+                 return(FALSE)
+                 }
+             }
+             
+         #   test pure black
+         black   = c(0,0,0)
+         if( ! identical( black, as.numeric(RGBfromXYZ( XYZfromRGB(black,space=space)$XYZ, space=space )$RGB ) ) )
+             {
+             printf(  "%s -> XYZ -> %s.back .  pure black not preserved.", space, space )
+             return(FALSE)
+             }        
+             
+         #   test pure white
+         white   = c(1,1,1)
+         delta   = white - as.numeric( RGBfromXYZ( XYZfromRGB(white,space=space)$XYZ, space=space )$RGB )
+         tol     = 5.e-16
+         if( tol < max(abs(delta)) )
+             {
+             printf(  "%s -> XYZ -> %s.back .  pure white not preserved.  delta=%g > %g", 
+                             space, space, delta, tol )
+             return(FALSE)
+             }
+             
+             
+         #   test rownames
+         if( ! identical( rownames(RGB), rownames(RGB.back) ) )
+             {
+             printf( "%s  -> XYZ -> %s .back .  rownames not preserved.", space, space )
+             return(FALSE)
+             }
+         }
+ 
+         
+     return( TRUE )
+     }
>      
>      
>      
> #   make points outside the gamut on purpose     
> testGamut  <- function()
+     {
+     printf( "---------------------  testGamut()  -----------------------" )
+         
+     #   make an ACES space
+     theOETF     = general.RRT( redmod='1.1+pinv' )  *  general.PODT( REC709_PRI, Ymax=100, surround='dim' )  *  sRGB.EOTF^-1 
+     theEOTF     = sRGB.EOTF 
+     ok  = installRGB( 'test-ACES', scene=AP0_PRI, OETF=theOETF, EOTF=theEOTF )
+     if( ! ok )  return(FALSE)
+     
+     domain  = domain(theOETF) #; print(domain)
+     if( ncol(domain) != 3 ) return(FALSE)   # something is wrong !
+     
+     edge    = domain[2, ] - domain[1, ]
+     center  = colMeans(domain)  #; print(center)
+     
+     # make random scene RGBs that are just outside the domain box
+     set.seed(0)    
+     count   = 1000
+     
+     RGBlin  = matrix( runif(3*count,min=-1,max=1), ncol=3 )
+     
+     #   push to boundary
+     rmax    = apply( abs(RGBlin), 1, max ) #; print(rmax)
+     
+     RGBlin  = RGBlin / rmax #; print(RGBlin)
+     
+     RGBlin  = matrix(center,count,3,byrow=T)  +  matrix( 1.01*edge/2 ,count,3,byrow=T) * RGBlin  #;  print(RGBlin)
+     
+     time_start      = gettime()    
+     
+     df  = SignalRGBfromLinearRGB( RGBlin, space='test-ACES', which='scene' )    #; print(df)
+     
+     time_elapsed    = gettime() - time_start
+     
+     RGB = df$RGB
+     
+     #   every row of RGB should between 0 and 1, or all NAs
+     myfun   <- function( RGB )
+         {
+         if( all(is.na(RGB)) )   return(TRUE)
+         
+         if( all( 0<=RGB & RGB<=1 ) )    return(TRUE)
+         
+         #   print( "bad RGB=%g,%g,%g", RGB[1], RGB[2], RGB[3] )
+         
+         return(FALSE)
+         }
+     
+     mask    = apply( RGB, 1, myfun ) #; print(mask)
+     
+     if( any( ! mask ) )
+         {
+         idx = which( ! mask )[1]
+         print( "bad RGB=%g,%g,%g", RGB[idx,1], RGB[idx,2], RGB[idx,3] )
+         return(FALSE)
+         }
+         
+     #   all should be outside
+     outside = df$OutOfGamut
+     if( any( ! outside ) )
+         {
+         idx = which( ! outside )[1]
+         print( "bad RGBlin=%g,%g,%g", RGBlin[idx,1], RGBlin[idx,2], RGBlin[idx,3] )
+         return(FALSE)
+         }
+     
+     printf( "Transformed %d ACES samples at %g sec/sample.", count, time_elapsed/count )
+     
+     return( TRUE )    
+     }
>      
>         
> x = gettime()   # load microbenchmark
>  
> if( ! testRGB() )       stop( "testRGB() failed !", call.=FALSE )
---------------------  testRGB()  ----------------------- 
sRGB         RGB ->    scene XYZ -> RGB    max(delta)=1.77547e-12   100000 samples at 2.76978e-06 sec/sample 
sRGB         RGB ->  display XYZ -> RGB    max(delta)=1.77547e-12   100000 samples at 3.26402e-06 sec/sample 
AdobeRGB     RGB ->    scene XYZ -> RGB    max(delta)=8.1882e-09   100000 samples at 2.41819e-06 sec/sample 
AdobeRGB     RGB ->  display XYZ -> RGB    max(delta)=8.1882e-09   100000 samples at 2.08741e-06 sec/sample 
ProPhotoRGB  RGB ->    scene XYZ -> RGB    max(delta)=7.86482e-13   100000 samples at 2.50594e-06 sec/sample 
ProPhotoRGB  RGB ->  display XYZ -> RGB    max(delta)=7.86482e-13   100000 samples at 3.34979e-06 sec/sample 
AppleRGB     RGB ->    scene XYZ -> RGB    max(delta)=1.8971e-10   100000 samples at 2.39987e-06 sec/sample 
AppleRGB     RGB ->  display XYZ -> RGB    max(delta)=1.8971e-10   100000 samples at 2.62336e-06 sec/sample 
BT.709       RGB ->    scene XYZ -> RGB    max(delta)=6.37379e-13   100000 samples at 3.10342e-06 sec/sample 
BT.709       RGB ->  display XYZ -> RGB    max(delta)=6.37379e-13   100000 samples at 2.54485e-06 sec/sample 
BT.2020      RGB ->    scene XYZ -> RGB    max(delta)=3.41061e-13   100000 samples at 3.5384e-06 sec/sample 
BT.2020      RGB ->  display XYZ -> RGB    max(delta)=3.41061e-13   100000 samples at 3.23562e-06 sec/sample 
240M         RGB ->    scene XYZ -> RGB    max(delta)=7.35412e-13   100000 samples at 2.73313e-06 sec/sample 
240M         RGB ->  display XYZ -> RGB    max(delta)=7.35412e-13   100000 samples at 2.87423e-06 sec/sample 
HD+2.4       RGB ->    scene XYZ -> RGB    max(delta)=6.37379e-13   100000 samples at 2.40649e-06 sec/sample 
HD+2.4       RGB ->  display XYZ -> RGB    max(delta)=1.20705e-07   100000 samples at 2.4129e-06 sec/sample 
> 
> if( ! testGamut() )     stop( "testGamut() failed !", call.=FALSE )
---------------------  testGamut()  ----------------------- 
Transformed 1000 ACES samples at 0.000357814 sec/sample. 
> 
> printf(  "\nPassed all Conversion tests !" )

Passed all Conversion tests ! 
>      
> 
> proc.time()
   user  system elapsed 
   4.39    1.12    5.50