Silently drop wl where sensdata is 0 if required

fix rmaia#74

R/vismodel.R

@@ -80,7 +80,7 @@
 #' Built-in `visual`, `achromatic`, `illum`, `bkg` and `trans` are only defined
 #' on the 300 to 700nm wavelength range. If you wish to work outside this range,
 #' you will need to provide your own data.
-#' 
+#'
 #' @importFrom stats quantile
 #'
 #' @export
@@ -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 transmission
@@ -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