Silently drop wl where sensdata is 0 if required

fix rmaia#74
Bisaloo · Sep 14, 2020 · 8d0526b · 8d0526b
1 parent f9583f7
commit 8d0526b
Showing 1 changed file with 15 additions and 7 deletions.
diff --git a/R/vismodel.R b/R/vismodel.R
@@ -267,10 +267,6 @@ vismodel <- function(rspecdata,
     )
   }
 
-  if (!isTRUE(all.equal(wl, sens_wl, check.attributes = FALSE))) {
-    stop("wavelength range in spectra and visual system data do not match")
-  }
-
   # DEFINING ILLUMINANT & BACKGROUND
 
   bgil <- bgandilum
@@ -279,14 +275,14 @@ vismodel <- function(rspecdata,
     illum <- bgil[, grep(illum2, names(bgil))]
   }
   if (illum2 == "ideal") {
-    illum <- rep(1, dim(rspecdata)[1])
+    illum <- rep_len(1, 401)
   }
 
   if (bg2 != "user-defined") {
     bkg <- bgil[, grep(bg2, names(bgil))]
   }
   if (bg2 == "ideal") {
-    bkg <- rep(1, dim(rspecdata)[1])
+    bkg <- rep_len(1, 401)
   }
 
   # Defining ocular  <- mission
@@ -296,7 +292,7 @@ vismodel <- function(rspecdata,
     trans <- trdat[, grep(tr2, names(trdat))]
   }
   if (tr2 == "ideal") {
-    trans <- rep(1, dim(rspecdata)[1])
+    trans <- rep_len(1, 401)
   }
 
   if (tr2 != "ideal" & visual2 == "user-defined") {
@@ -338,6 +334,18 @@ vismodel <- function(rspecdata,
   illum <- prepare_userdefined(illum)
   achromatic <- prepare_userdefined(achromatic)
 
+  if (!isTRUE(all.equal(wl, sens_wl, check.attributes = FALSE))) {
+    if (all(S[!sens_wl %in% wl, ] == 0)) {
+      S <- S[sens_wl %in% wl, ]
+      trans <- trans[sens_wl %in% wl]
+      bkg <- bkg[sens_wl %in% wl]
+      illum <- illum[sens_wl %in% wl]
+      achromatic <- achromatic[sens_wl %in% wl]
+    } else {
+      stop("wavelength range in spectra and visual system data do not match")
+    }
+  }
+
   # Transform from percentages to proportions (Vorobyev 2003)
   if (max(y) > 1) {
     y <- y / 100