R version 4.5.0 RC (2025-04-04 r88112 ucrt) -- "How About a Twenty-Six"
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(Polychrome)
> library(colorspace)
> 
> #########################################
> ## Test the background algorithm
> 
> ## checking the conversion between RGB and sRGB
> y <- seq(0, 1, length=500)
> liny <- Polychrome:::srgb2rgb(y)
> plot(y, liny)
> 
> yback <- Polychrome:::rgb2srgb(liny)
> plot(y, yback)
> abline(0,1)
> summary(y - yback)
      Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
-1.110e-16  0.000e+00  0.000e+00  5.239e-19  0.000e+00  1.110e-16 
> 
> ## comparing with colorspace
> 
> p36 <- palette36.colors(36)
> srgb <- hex2RGB(p36)
> mat <- srgb@coords
> linrgb <- as(srgb, "RGB")
> linmat <- Polychrome:::srgb2rgb(mat)
> summary(linmat - linrgb@coords) # all 0, so we are doing the same thing
       R           G           B    
 Min.   :0   Min.   :0   Min.   :0  
 1st Qu.:0   1st Qu.:0   1st Qu.:0  
 Median :0   Median :0   Median :0  
 Mean   :0   Mean   :0   Mean   :0  
 3rd Qu.:0   3rd Qu.:0   3rd Qu.:0  
 Max.   :0   Max.   :0   Max.   :0  
> 
> ## since our structures have row vectors instead of columns,
> ## we need to transpose stuff
> xyz <- linmat %*% t(Polychrome:::RGB2XYZ)
> rgb.back <- xyz %*% t(Polychrome:::XYZ2RGB)
> summary(round(linmat - rgb.back, 3)) # accurate to 4 decimal places
       R           G           B    
 Min.   :0   Min.   :0   Min.   :0  
 1st Qu.:0   1st Qu.:0   1st Qu.:0  
 Median :0   Median :0   Median :0  
 Mean   :0   Mean   :0   Mean   :0  
 3rd Qu.:0   3rd Qu.:0   3rd Qu.:0  
 Max.   :0   Max.   :0   Max.   :0  
> 
> ## multiple options for convertiong XYZ spoace to LMS perceptual space
> 
> ## check that these are projections
> all(Polychrome:::lms2lmsd == Polychrome:::lms2lmsd %*% Polychrome:::lms2lmsd)
[1] TRUE
> all(Polychrome:::lms2lmsp == Polychrome:::lms2lmsp %*% Polychrome:::lms2lmsp)
[1] TRUE
> all(Polychrome:::lms2lmst == Polychrome:::lms2lmst %*% Polychrome:::lms2lmst)
[1] TRUE
> 
> ## check the complete round trip
> M <- Polychrome:::backward(Polychrome:::forward(mat))
> summary(round(M - mat, 3))
       V1          V2          V3   
 Min.   :0   Min.   :0   Min.   :0  
 1st Qu.:0   1st Qu.:0   1st Qu.:0  
 Median :0   Median :0   Median :0  
 Mean   :0   Mean   :0   Mean   :0  
 3rd Qu.:0   3rd Qu.:0   3rd Qu.:0  
 Max.   :0   Max.   :0   Max.   :0  
> 
> 
> #########################################
> ## Test user-visible commands
> 
> ## three input types
> p36 <- palette36.colors(36)
> srgb <- hex2RGB(p36)
> class(srgb)
[1] "sRGB"
attr(,"package")
[1] "colorspace"
> mat <- srgb@coords
> 
> ## check that each one works
> daltMat <- colorDeficit(mat, target="deut") # matrix conversion
> daltRGB <- colorDeficit(srgb, target="deut") # object conversion
> all(daltMat == daltRGB@coords) # agreement
[1] TRUE
> 
> daltP36 <- colorDeficit(p36, "deut") # hex string conversion
> all(daltP36 == hex(daltRGB)) # agreement
[1] TRUE
> 
> # invariance
> reup <- colorDeficit(daltMat, "deut")
> all(daltMat == reup) # why false?
[1] FALSE
> all(abs(daltMat - reup) < 0.4)
[1] TRUE
> 
> sndP36 <- hex(new("sRGB", coords=reup))
> 
> opar <- par(mfrow=c(3,1))
> swatch(p36)
> swatch(daltP36)
> swatch(sndP36)
> par(opar)
> 
> swatchHue(daltP36)
> uvscatter(daltP36)
> luminance(daltP36)
> plotDistances(daltP36, cex=2)
> 
> 
> cp <- createPalette(25, c("#111111", "#eeeeee"),
+                     target="deuteranope", M=10000)
> swatch(cp)
> plotDistances(cp)
> 
> cp <- createPalette(25, c("#111111", "#eeeeee"),
+                     target="prot", M=10000)
> swatch(cp)
> plotDistances(cp)
> 
> cp <- createPalette(25, c("#111111", "#eeeeee"),
+                     target="trit", M=10000)
> swatch(cp)
> plotDistances(cp)
> 
> 
> proc.time()
   user  system elapsed 
   1.39    0.07    1.45