From f28f37982f44d82502f5fed850a60cca434b55b2 Mon Sep 17 00:00:00 2001
From: "Andrew G. Brown" <andrew.g.brown@usda.gov>
Date: Wed, 29 Jun 2022 13:37:35 -0700
Subject: [PATCH] uncode/code: use `type.convert()` not `as.character()`for
 converting from factor

 - uncode: Use `NASISDomainsAsFactor()` to check package option
---
 R/uncode.R                   | 13 +++++++------
 man/get_NASIS_metadata.Rd    |  2 +-
 man/uncode.Rd                |  2 +-
 tests/testthat/test-uncode.R | 25 +++++++++++++++++++++++++
 4 files changed, 34 insertions(+), 8 deletions(-)
 create mode 100644 tests/testthat/test-uncode.R

diff --git a/R/uncode.R b/R/uncode.R
index 016155fb..09c4c9b5 100644
--- a/R/uncode.R
+++ b/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)
 }
 
diff --git a/man/get_NASIS_metadata.Rd b/man/get_NASIS_metadata.Rd
index f92f9146..7ed0b9c9 100644
--- a/man/get_NASIS_metadata.Rd
+++ b/man/get_NASIS_metadata.Rd
@@ -14,7 +14,7 @@ get_NASIS_column_metadata(x, what = "ColumnPhysicalName", dsn = NULL)
 
 \item{x}{character vector to match in NASIS metadata}
 
-\item{what}{Column to match \code{x} against. Default "ColumnPhysicalName"; alternate options include \code{"DomainID"}, \code{"DomainName"}, \code{"DomainRanked"}, \code{"DisplayLabel"}, \code{"ChoiceSequence"}, \code{"ChoiceValue"}, \code{"ChoiceName"}, \code{"ChoiceLabel"}, \code{"ChoiceObsolete"}, \code{"ChoiceDescription"}, \code{"ColumnLogicalName"}}
+\item{what}{Column to match \code{x} against. Default \code{"ColumnPhysicalName"}; alternate options include \code{"DomainID"}, \code{"DomainName"}, \code{"DomainRanked"}, \code{"DisplayLabel"}, \code{"ChoiceSequence"}, \code{"ChoiceValue"}, \code{"ChoiceName"}, \code{"ChoiceLabel"}, \code{"ChoiceObsolete"}, \code{"ChoiceDescription"}, \code{"ColumnLogicalName"}}
 }
 \value{
 a \code{data.frame} containing DomainID, DomainName, DomainRanked, DisplayLabel, ChoiceSequence, ChoiceValue, ChoiceName, ChoiceLabel, ChoiceObsolete, ColumnPhysicalName, ColumnLogicalName
diff --git a/man/uncode.Rd b/man/uncode.Rd
index 164c79e9..09cb50c9 100644
--- a/man/uncode.Rd
+++ b/man/uncode.Rd
@@ -14,7 +14,7 @@ uncode(
   dsn = NULL
 )
 
-code(df, db = "NASIS", droplevels = FALSE, stringsAsFactors = NULL, dsn = NULL)
+code(df, db = NULL, droplevels = FALSE, stringsAsFactors = NULL, dsn = NULL)
 }
 \arguments{
 \item{df}{data.frame}
diff --git a/tests/testthat/test-uncode.R b/tests/testthat/test-uncode.R
new file mode 100644
index 00000000..bf2c5d85
--- /dev/null
+++ b/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)
+})