Merge pull request #254 from rmaia/as.rspec-tibbles

Fix as.rspec with tibbles
rmaia · Nov 29, 2023 · 2fcb2d0 · 2fcb2d0
2 parents b01dd9b + 54eb48c
commit 2fcb2d0
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 16 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # pavo 2.10.0
 
+## MINOR FEATURES AND BUG FIXES
+
+- `as.rspec()` now works out of the box with `tibble`, rather than requiring users to pass a standard data.frame.
+
 # pavo 2.9.0
 
 ## NEW FEATURES AND SIGNIFICANT CHANGES

diff --git a/R/as.rspec.R b/R/as.rspec.R
@@ -45,18 +45,13 @@
 as.rspec <- function(object, whichwl = NULL,
                      interp = TRUE, lim = NULL, exceed.range = TRUE) {
 
-  # tibble dodge
-  if (inherits(object, "tbl_df")) {
-    object <- data.frame(object, check.names = FALSE)
-  }
-
   if (is.matrix(object) || is.data.frame(object)) {
     name <- colnames(object)
   } else {
     stop("object must be a data frame or matrix", call. = FALSE)
   }
 
-  if (!all(vapply(seq_len(ncol(object)), function(j) is.numeric(object[, j]), logical(1)))) {
+  if (!all(vapply(seq_len(ncol(object)), function(j) is.numeric(object[, j, drop = TRUE]), logical(1)))) {
     stop("all columns must contain numeric data", call. = FALSE)
   }
 
@@ -85,7 +80,7 @@ as.rspec <- function(object, whichwl = NULL,
     } else if (is.character(whichwl)) {
       wl_index <- which(colnames(object) == whichwl)
     }
-    wl <- object[, wl_index]
+    wl <- object[, wl_index, drop = TRUE]
     object <- object[, -wl_index, drop = FALSE]
     name <- name[-wl_index]
   } else {
@@ -95,7 +90,7 @@ as.rspec <- function(object, whichwl = NULL,
 
     if (any(ind > 0.999)) {
       wl_index <- which(ind > 0.999)[1]
-      wl <- object[, wl_index]
+      wl <- object[, wl_index, drop = TRUE]
       object <- object[, -wl_index, drop = FALSE]
       name <- name[-wl_index]
       message("wavelengths found in column ", wl_index)
@@ -126,14 +121,12 @@ as.rspec <- function(object, whichwl = NULL,
   } else {
     l1 <- lim[1]
     l2 <- lim[2]
-    if (l1.dat > lim[1] || l2.dat < lim[2]) {
-      if (exceed.range) {
-        warning(
-          "Interpolating beyond the range of actual data.\n",
-          "Check 'lim' and `exceed.range` arguments to confirm this is the desired behaviour.",
-          call. = FALSE
-        )
-      }
+    if ((l1.dat > lim[1] || l2.dat < lim[2]) && exceed.range) {
+      warning(
+        "Interpolating beyond the range of actual data.\n",
+        "Check 'lim' and `exceed.range` arguments to confirm this is the desired behaviour.",
+        call. = FALSE
+      )
     }
   }