sppMatch: bug fix for return of a logical column

Author: suz-estella

R/CBM-DB_species.R

@@ -55,18 +55,9 @@ sppMatch <- function(species, match = c("LandR", "Latin_full", "EN_generic_short
     "column(s) not found in sppEquiv: ",
     paste(shQuote(c(match, return)[!colExists]), collapse = ", "))
 
+  # Allow duplicate matches if there is a single unique set of return values
   if (!is.null(return)){
-
-    # Allow duplicate matches if there is a single unique set of return rows
-    ## Create secondary matches from duplicated rows
-    sppEquivUQ <- sppEquiv[, lapply(.SD, function(x) list(list(x))), by = return]
-
-    sppEquiv  <- sppEquivUQ[, .SD, .SDcols = c(match, return)]
-    sppExtras <- sppEquivUQ[, .SD, .SDcols = setdiff(names(sppEquiv), c(match, return))]
-    if (ncol(sppExtras) == 0) sppExtras <- NULL
-
-  }else{
-    sppExtras <- NULL
+    sppEquiv <- unique(sppEquiv[, .SD, .SDcols = unique(c(match, return))])
   }
 
   # Set function for matching character columns
@@ -113,7 +104,6 @@ sppMatch <- function(species, match = c("LandR", "Latin_full", "EN_generic_short
       inputs      = speciesUQ,
       choices     = choices,
       choiceTable = sppEquiv,
-      choiceTableExtra = sppExtras,
       identical   = TRUE,
       funSimplify = .chSimple,
       nearMatches = nearMatches,

tests/testthat/test-CBM-DB_species.R

@@ -173,6 +173,16 @@ test_that("sppMatch to a chosen column", {
     ))
   expect_equal(sppTable$CBM_speciesID, c(28, 122))
 
+  sppTable <- sppMatch(
+    species = c(301, 2201),
+    match   = "CanfiCode",
+    return  = "Broadleaf",
+    sppEquiv = rbind(
+      sppEquiv,
+      sppEquiv[sppEquiv$CanfiCode %in% 301,]
+    ))
+  expect_equal(sppTable$Broadleaf, c(FALSE, TRUE))
+
   # Expect error: NAs in input
   expect_error(
     sppMatch(