uncode/code: use type.convert() not as.character()for converting …

…from factor

 - uncode: Use `NASISDomainsAsFactor()` to check package option

R/uncode.R

@@ -138,11 +138,12 @@ uncode <- function(df,
     df <- droplevels(df, except = idx)
   }
 
-  # convert factors to strings, check soilDB option first
-  if ((length(stringsAsFactors) > 0 && !stringsAsFactors) ||
-      !getOption("soilDB.NASIS.DomainsAsFactor", default = FALSE)) {
+  # convert factors to strings/numeric, check soilDB option first
+  if (invert || (length(stringsAsFactors) > 0 && !stringsAsFactors) || !NASISDomainsAsFactor()) {
     idx <- unlist(lapply(df, is.factor))
-    df[idx] <- lapply(df[idx], as.character)
+    df[idx] <- lapply(df[idx], function(x) {
+      type.convert(x, as.is = TRUE)
+    })
   }
 
   return(df)
@@ -152,11 +153,11 @@ uncode <- function(df,
 #' @export
 #' @rdname uncode
 code <- function(df, 
-                 db = "NASIS",
+                 db = NULL,
                  droplevels = FALSE,
                  stringsAsFactors = NULL,
                  dsn = NULL) {
-  res <- uncode(df, invert = TRUE, db = db, droplevels = droplevels, stringsAsFactors = stringsAsFactors, dsn = dsn) 
+  res <- uncode(df, invert = TRUE, droplevels = droplevels, stringsAsFactors = stringsAsFactors, dsn = dsn) 
   return(res)
 }
 

tests/testthat/test-uncode.R

@@ -0,0 +1,25 @@
+test_that("uncode() works", {
+  x <- data.frame(texcl = 1:10)
+  expect_equal(uncode(x)$texcl, c("cos", "s", "fs", "vfs", "lcos", "ls", "lfs", "lvfs", "cosl", "sl")) 
+})
+
+test_that("uncode() works w/ NASISDomainsAsFactor(TRUE)", {
+  NASISDomainsAsFactor(TRUE)
+  x <- data.frame(texcl = 1:10)
+  expect_equal(uncode(x)$texcl, structure(1:10, .Label = c("cos", "s", "fs", "vfs", "lcos", "ls", 
+                                                           "lfs", "lvfs", "cosl", "sl", "fsl", "vfsl", "l", "sil", "si", 
+                                                           "scl", "cl", "sicl", "sc", "sic", "c"), class = "factor")) 
+  NASISDomainsAsFactor(FALSE)
+})
+
+test_that("code() works", {
+  x <- data.frame(texcl = c("cos", "s", "fs", "vfs", "lcos", "ls", "lfs", "lvfs", "cosl", "sl"))
+  expect_equal(code(x)$texcl, 1:10) 
+})
+
+test_that("code() works w/ NASISDomainsAsFactor(TRUE)", {
+  NASISDomainsAsFactor(TRUE)
+  x <- data.frame(texcl = c("cos", "s", "fs", "vfs", "lcos", "ls", "lfs", "lvfs", "cosl", "sl"))
+  expect_equal(code(x)$texcl, 1:10) 
+  NASISDomainsAsFactor(FALSE)
+})