Create stricter tests for jnd2xyz()

NEWS.md

@@ -3,6 +3,13 @@
 ## NEW FEATURES AND SIGNIFICANT CHANGES
 
 - the `rimg2cimg()` function has been removed in favour of a custom `as.cimg()` method. 
+- `jndrot()` and by extension `jnd2xyz()` have been adjusted for trichromats to
+  only allow rotations in the 2D plane. Until now, 3D rotations were allowed and
+  the result was projected back in 2D but this meant that the output was no
+  longer representing JNDs distances. Because `rotate = TRUE` is the default in
+  `jnd2xyz()`, we recommend you re-run any `jnd2xyz()` computation on
+  trichromats. From our tests, results stay qualitatively similar but specific
+  values may change.
 
 ## MINOR FEATURES AND BUG FIXES
 

R/jnd2xyz.R

@@ -17,14 +17,18 @@
 #' (for no first rotation in the 3-dimensional case) or must match name
 #' in the original data that was used for [coldist()]. Defaults to 'u'.
 #' (only used if data has 3 dimensions).
-#' @param axis1 A vector of length 3 composed of 0's and 1's, with
-#' 1's representing the axes (x, y, z) to rotate around. Defaults to c(1, 1, 0), such
-#' that the rotation aligns with the xy plane (only used if data has 2 or 3 dimensions).
-#' Ignored if `ref1` is `NULL` (in 3-dimensional case only)
-#' @param axis2 A vector of length 3 composed of 0's and 1's, with
-#' 1's representing the axes (x, y, z) to rotate around. Defaults to c(0, 0, 1), such
-#' that the rotation aligns with the z axis (only used if data has 3 dimensions).
-#' Ignored if `ref2` is `NULL` (in 3-dimensional case only)
+#' @param axis1 A vector of length number of cones minus 1 composed of 0's and
+#' 1's, with 1's representing the axes (x, y, z) to rotate around. Defaults to
+#' c(1, 1, 0) in 3 dimensions, such that the rotation aligns with the xy plane,
+#' and c(1, 0) in 2 dimentions, such that the rotation is centered on the x
+#' axis. Ignored if `ref1` is `NULL` (in 3-dimensional case only). Ignored for
+#' dichromats.
+#' @param axis2 A vector of length number of cones minus 1 composed of 0's and
+#' 1's, with 1's representing the axes (x, y, z) to rotate around. Defaults to
+#' c(0, 0, 1) in 3 dimensions, such that the rotation aligns with the z axis,
+#' and c(0, 1) in 2 dimentions, such that the rotation is centered on the y
+#' axis. Ignored if `ref1` is `NULL` (in 3-dimensional case only). Ignored for
+#' dichromats.
 #'
 #' @examples
 #' # Load floral reflectance spectra
@@ -53,7 +57,7 @@
 
 jnd2xyz <- function(coldistres, center = TRUE, rotate = TRUE,
                     rotcenter = c("mean", "achro"), ref1 = "l", ref2 = "u",
-                    axis1 = c(1, 1, 0), axis2 = c(0, 0, 1)) {
+                    axis1, axis2) {
   # Accessory functions
   pos2 <- function(d12, d13, d23) {
     x3 <- d13
@@ -268,14 +272,16 @@ jnd2xyz <- function(coldistres, center = TRUE, rotate = TRUE,
   attr(chromcoords, "resref") <- refstosave
 
   if (rotate) {
-    rotcenter <- match.arg(rotcenter)
-    rotarg <- list(
-      jnd2xyzres = chromcoords, center = rotcenter,
-      ref1 = ref1, ref2 = ref2, axis1 = axis1, axis2 = axis2
-    )
+      axis1 <- c(rep_len(1, as.numeric(ncone) - 2), 0)
+      axis2 <- c(0, 0, 1)
+      rotcenter <- match.arg(rotcenter)
+      rotarg <- list(
+        jnd2xyzres = chromcoords, center = rotcenter,
+        ref1 = ref1, ref2 = ref2, axis1 = axis1, axis2 = axis2
+      )
 
-    chromcoords <- do.call(jndrot, rotarg)
-  }
+      chromcoords <- do.call(jndrot, rotarg)
+    }
 
   chromcoords
 }

R/jndrot.R

@@ -74,41 +74,11 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
 
   # two dimensions
   if (round(sum(c("x", "y", "z") %in% colnames(coords))) == 2) {
-    coords <- cbind(coords, tempcol = 0)
-
-    if (length(axis1) != 3) {
-      stop('"axis1" must be a vector of length 3', call. = FALSE)
+    if (length(axis1) != 2 && sum(axis1) != 1) {
+      stop('"axis1" must be (0, 1) or (1, 0)', call. = FALSE)
     }
 
-    cent <- switch(center,
-      achro = coords["jnd2xyzrrf.achro", ],
-      mean = coords["jnd2xyzrrf.ctrd", ]
-    )
-
-    aa <- vectornorm(coords[grep(paste0("jnd2xyzrrf.", ref1), rownames(coords)), ] -
-      cent)
-    bb <- vectornorm(axis1)
-    daabb <- drop(crossprod(aa, bb))
-    ncaabb <- vectormag(vectorcross(aa, bb))
-    GG <- rbind(
-      c(daabb, -ncaabb, 0),
-      c(ncaabb, daabb, 0),
-      c(0, 0, 1)
-    )
-    FF <- cbind(
-      aa,
-      vectornorm(bb - daabb * aa),
-      vectorcross(bb, aa)
-    )
-
-    RR <- FF %*% GG %*% solve(FF)
-
-    res <- sweep(coords, 2, cent, "-")
-    res <- tcrossprod(res, RR)
-    # res <- sweep(res, 2, coords['jnd2xyzrrf.achro',], '+')
-
-    res <- res[, -dim(res)[2]]
-    coords <- coords[, -dim(coords)[2]]
+    res <- t(t(coords) * (-2 * axis1 + 1))
     colnames(res) <- colnames(coords)
   }
 

tests/testthat/_snaps/jnd2xyz.md

@@ -0,0 +1,129 @@
+# JND space for dichromat
+
+    Code
+      jnd_x_rot
+    Output
+                                           x
+      Goodenia_heterophylla       6.98369053
+      Goodenia_geniculata        -1.45997294
+      Goodenia_gracilis         -22.34338359
+      Xyris_operculata            3.11283493
+      Eucalyptus_sp               3.46473171
+      Faradaya_splendida         -2.33062092
+      Gaultheria_hispida          4.72952144
+      Geitonoplesium_cymosum      2.46663805
+      Euryomyrtus_ramosissima     0.58130781
+      Genista_linifolia          -0.07539070
+      Genista_monspessulana       1.38400959
+      Geranium_sp                 6.69750041
+      Glycine_clandestina         0.66799975
+      Gompholobium_ecostatum_1    4.32203875
+      Gompholobium_ecostatum_2   -0.09562108
+      Gompholobium_grandiflorum  -8.14561399
+      Gompholobium_huegelii       4.25424086
+      Gompholobium_virgatum       4.39580028
+      Gonocarpus_humilis          2.34104837
+      Gonocarpus_teucrioides      1.90381923
+      Hibbertia_obtusifolia      -0.59574803
+      Zieria_arborescens         -1.97634591
+      Goodenia_lanata           -13.23191155
+      Goodenia_ovata             -0.23345509
+      Goodenia_rotundifolia       8.28959951
+      Grevillea_buxifolia         5.29685040
+      Grevillea_steiglitziana    -8.04880987
+      Grevillea_oleoides          0.61375449
+      Gymnostachys_anceps       -17.24608243
+      Hakea_actites               7.59808360
+      Hardenbergia_violaceae     -4.00015785
+      Hibbertia_acicularis        3.10619660
+      Hibbertia_bracteata         7.27905645
+      Hibbertia_empetrifolia     -0.98725246
+      Hibbertia_procumbens        2.66926650
+      Hibbertia_linearis         -1.38762284
+
+# JND space for trichromat
+
+    Code
+      jnd_xy_rot
+    Output
+                                          x          y
+      Goodenia_heterophylla       6.3480194 -2.8326663
+      Goodenia_geniculata        -6.7845426 -2.8326663
+      Goodenia_gracilis         -26.9491899  5.1713543
+      Xyris_operculata           -3.7801524 -6.2628731
+      Eucalyptus_sp               1.4387012 -2.3704461
+      Faradaya_splendida         -3.4369287  0.5535380
+      Gaultheria_hispida         -1.7242711 -6.1574817
+      Geitonoplesium_cymosum     10.6138451 -5.0159263
+      Euryomyrtus_ramosissima     3.9732416  2.6651245
+      Genista_linifolia          -3.9512915 -2.2693489
+      Genista_monspessulana      -3.9632532 -3.8664782
+      Geranium_sp                20.5797701  5.2676725
+      Glycine_clandestina        -5.1952543 -3.9780344
+      Gompholobium_ecostatum_1    8.8494576  1.2228705
+      Gompholobium_ecostatum_2   -8.1425032 -5.1717936
+      Gompholobium_grandiflorum -12.0023319  1.1621356
+      Gompholobium_huegelii       6.9425704  0.3384758
+      Gompholobium_virgatum       8.4036953  1.0621232
+      Gonocarpus_humilis         -4.5503516 -5.2902633
+      Gonocarpus_teucrioides      1.0973610 -0.9678251
+      Hibbertia_obtusifolia      -1.5465552 -0.1090498
+      Zieria_arborescens         13.2845458 12.4324049
+      Goodenia_lanata           -20.4042597  1.0020845
+      Goodenia_ovata             15.2500283 11.4405261
+      Goodenia_rotundifolia       6.8887070 -3.9456698
+      Grevillea_buxifolia         0.6377147 -5.2041348
+      Grevillea_steiglitziana    -1.7267988  8.5788053
+      Grevillea_oleoides         -3.9599076 -3.0815382
+      Gymnostachys_anceps       -13.6405693  9.6803718
+      Hakea_actites               8.5673092 -1.8863410
+      Hardenbergia_violaceae     -3.8791714  2.0220996
+      Hibbertia_acicularis        2.2902158 -1.4023280
+      Hibbertia_bracteata         5.6267326 -4.5900439
+      Hibbertia_empetrifolia     13.7311173 11.4963747
+      Hibbertia_procumbens       -2.1401164 -3.9888226
+      Hibbertia_linearis         -6.7455836 -2.8722300
+
+# JND space for tetrachromat
+
+    Code
+      jnd_xyz_rot
+    Output
+                                           x          y           z
+      Goodenia_heterophylla      1.312355137 -5.3667601   6.8629524
+      Goodenia_geniculata       -0.648798700 -2.5312331  -6.5456726
+      Goodenia_gracilis         -4.834850372 10.6831212 -22.9236622
+      Xyris_operculata           3.150779009 -1.0781817  -2.8997962
+      Eucalyptus_sp             -0.082973918 -3.1963203   3.1550303
+      Faradaya_splendida        -1.266831951  0.4892355  -2.8528294
+      Gaultheria_hispida         2.274592892 -3.9525120  -1.1742262
+      Geitonoplesium_cymosum     8.033650770 -6.9198494   8.2932612
+      Euryomyrtus_ramosissima   -2.010687966 -0.3710342   4.6922247
+      Genista_linifolia         -0.617218669 -1.7069294  -2.1501789
+      Genista_monspessulana     -0.202733928 -3.0304197  -2.4820412
+      Geranium_sp                7.705016804  6.7723067  10.8297259
+      Glycine_clandestina       -0.172096284 -2.6365121  -4.2701064
+      Gompholobium_ecostatum_1   2.342604074  0.1315023   5.5688334
+      Gompholobium_ecostatum_2  -0.394030123 -2.0067259  -5.3306567
+      Gompholobium_grandiflorum -3.043177182  4.4548815  -6.5433920
+      Gompholobium_huegelii      0.731726587 -1.7597445   6.1230907
+      Gompholobium_virgatum      1.595663823 -1.1755990   5.9025137
+      Gonocarpus_humilis         0.047486608 -3.7116414  -2.6939291
+      Gonocarpus_teucrioides    -0.143737261 -2.1236747   2.1280934
+      Hibbertia_obtusifolia     -0.546715949 -1.3648630  -2.0026397
+      Zieria_arborescens        -4.374219169  8.9888446   8.7021306
+      Goodenia_lanata           -4.221201078  7.4641726 -12.6997701
+      Goodenia_ovata            -3.131626826 10.5294641   9.6861976
+      Goodenia_rotundifolia      2.743882379 -6.2826784   6.1909786
+      Grevillea_buxifolia        2.422158828 -3.4693196   1.9123426
+      Grevillea_steiglitziana   -4.435969376  5.1580526  -1.1327863
+      Grevillea_oleoides        -0.165755432 -3.0178116  -4.1570956
+      Gymnostachys_anceps       -4.457785440  9.9350339  -9.8694685
+      Hakea_actites              1.020732338 -6.3835620   8.4297774
+      Hardenbergia_violaceae    -1.543741054  0.4977253  -3.4332417
+      Hibbertia_acicularis      -0.009957462 -3.4147937   1.9458170
+      Hibbertia_bracteata        7.213297113 -2.2921695   1.6605064
+      Hibbertia_empetrifolia    -3.739762049  8.0698186   8.8247528
+      Hibbertia_procumbens       0.056155445 -3.3090457  -0.3154626
+      Hibbertia_linearis        -0.606231617 -2.0727778  -7.4312733
+

tests/testthat/test-jnd2xyz.R

@@ -0,0 +1,60 @@
+data(flowers)
+
+test_that("JND space for dichromat", {
+
+  canis.flowers <- vismodel(flowers, visual = "canis")
+  cd.flowers <- coldist(canis.flowers, n = c(1, 1))
+
+  jnd_x <- jnd2xyz(cd.flowers, rotate = FALSE)
+
+  jnd_x_rot <- jnd2xyz(cd.flowers, rotate = TRUE)
+
+  expect_snapshot(jnd_x_rot)
+
+  # Rotation doesn't change the distances
+  expect_equal(
+    dist(jnd_x),
+    dist(jnd_x_rot),
+    ignore_attr = "call"
+  )
+
+})
+
+test_that("JND space for trichromat", {
+
+  apis.flowers <- vismodel(flowers, visual = "apis")
+  cd.flowers <- coldist(apis.flowers, n = c(1, 1, 1))
+
+  jnd_xy <- jnd2xyz(cd.flowers, rotate = FALSE)
+
+  jnd_xy_rot <- jnd2xyz(cd.flowers, rotate = TRUE)
+
+  expect_snapshot(jnd_xy_rot)
+
+  # Rotation doesn't change the distances
+  expect_equal(
+    dist(jnd_xy),
+    dist(jnd_xy_rot),
+    ignore_attr = "call"
+  )
+
+})
+
+test_that("JND space for tetrachromat", {
+
+  bluetit.flowers <- vismodel(flowers, visual = "bluetit")
+  cd.flowers <- coldist(bluetit.flowers)
+
+  jnd_xyz <- jnd2xyz(cd.flowers, rotate = FALSE)
+
+  jnd_xyz_rot <- jnd2xyz(cd.flowers, rotate = TRUE)
+
+  expect_snapshot(jnd_xyz_rot)
+
+  # Rotation doesn't change the distances
+  expect_equal(
+    dist(jnd_xyz),
+    dist(jnd_xyz_rot),
+    ignore_attr = "call"
+  )
+})