Skip to content

Commit

Permalink
Deprecate stringsAsFactors argument to uncode() (#240)
Browse files Browse the repository at this point in the history 
* Deprecate `stringsAsFactors` argument to `uncode()` #130
 - default.stringsAsFactors() has been deprecated;

* fetchHenry: backward compatibility with R<4.0

* Add soilDB.NASIS.DomainsAsFactor option and helper function NASISDomainsAsFactor() to facilitate deprecation of base R stringsAsFactors option

* Docs
  • Loading branch information
@brownag
brownag authored Mar 4, 2022
1 parent 852760f commit 0d0c0cd
Show file tree
Hide file tree
Showing 42 changed files with 512 additions and 410 deletions.
2 changes: 1 addition & 1 deletion R/fetchHenry.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -287,7 +287,7 @@ fetchHenry <- function(what='all', usersiteid=NULL, project=NULL, sso=NULL, gran
if(!requireNamespace('jsonlite', quietly=TRUE))
stop('please install the `jsonlite` packages', call.=FALSE)

# important: change the default behavior of data.frame
# important: backward compatibility R <4.0
opt.original <- options(stringsAsFactors = FALSE)

# sanity-check: `what` should be within the legal set of options
Expand Down
17 changes: 8 additions & 9 deletions R/fetchNASIS.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,10 +56,7 @@
#' @param lab should the `phlabresults` child table be fetched with
#' site/pedon/horizon data (default: `FALSE`)
#' @param fill include pedon or component records without horizon data in result? (default: `FALSE`)
#' @param stringsAsFactors logical: should character vectors be converted to
#' factors? This argument is passed to the `uncode()` function. It does not
#' convert those vectors that have been set outside of `uncode()` (i.e. hard
#' coded).
#' @param stringsAsFactors deprecated
#' @param dsn Optional: path to local SQLite database containing NASIS
#' table structure; default: `NULL`
#' @return A SoilProfileCollection object
Expand All @@ -75,11 +72,16 @@ fetchNASIS <- function(from = 'pedons',
soilColorState = 'moist',
lab = FALSE,
fill = FALSE,
stringsAsFactors = default.stringsAsFactors(),
stringsAsFactors = NULL,
dsn = NULL) {

res <- NULL


if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

# TODO: do we need _View_1 tables in the sqlite table snapshot? Could be handy for
# specialized selected sets crafted by NASIS/CVIR stuff; currently you are allowed
# to specify the selected set for a SQLite database, and I suppose the convention
Expand All @@ -101,7 +103,6 @@ fetchNASIS <- function(from = 'pedons',
nullFragsAreZero = nullFragsAreZero,
soilColorState = soilColorState,
lab = lab,
stringsAsFactors = stringsAsFactors,
dsn = dsn)
}

Expand All @@ -111,7 +112,6 @@ fetchNASIS <- function(from = 'pedons',
rmHzErrors = rmHzErrors,
nullFragsAreZero = nullFragsAreZero,
fill = fill,
stringsAsFactors = stringsAsFactors,
dsn = dsn)
}

Expand All @@ -121,7 +121,6 @@ fetchNASIS <- function(from = 'pedons',
rmHzErrors = rmHzErrors,
nullFragsAreZero = nullFragsAreZero,
soilColorState = soilColorState,
stringsAsFactors = stringsAsFactors
)
}

Expand Down
97 changes: 66 additions & 31 deletions R/fetchNASISWebReport.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,11 +25,7 @@
#' @param fill should rows with missing component ids be removed (default: `FALSE`)
#' @param rmHzErrors should pedons with horizonation errors be removed from the
#' results? (default: `FALSE`)
#' @param stringsAsFactors logical: should character vectors be converted to
#' factors? This argument is passed to the `uncode()` function. It does not
#' convert those vectors that have been set outside of `uncode()` (i.e. hard
#' coded). The 'factory-fresh' default is TRUE, but this can be changed by
#' setting options(`stringsAsFactors = FALSE`)
#' @param stringsAsFactors deprecated
#' @param droplevels logical: indicating whether to drop unused levels in
#' classifying factors. This is useful when a class has large number of unused
#' classes, which can waste space in tables and figures.
Expand All @@ -39,13 +35,17 @@
#'
#' @export fetchNASISWebReport
fetchNASISWebReport <- function(projectname, rmHzErrors = FALSE, fill = FALSE,
stringsAsFactors = default.stringsAsFactors()
) {

stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

# load data in pieces
f.mapunit <- get_projectmapunit_from_NASISWebReport(projectname, stringsAsFactors = stringsAsFactors)
f.component <- get_component_from_NASISWebReport(projectname, stringsAsFactors = stringsAsFactors)
f.chorizon <- get_chorizon_from_NASISWebReport(projectname, fill, stringsAsFactors = stringsAsFactors)
f.mapunit <- get_projectmapunit_from_NASISWebReport(projectname)
f.component <- get_component_from_NASISWebReport(projectname)
f.chorizon <- get_chorizon_from_NASISWebReport(projectname, fill)

# return NULL if one of the required pieces is missing
if(is.null(f.mapunit) | is.null(f.component) | is.null(f.chorizon)) {
Expand Down Expand Up @@ -94,8 +94,13 @@ fetchNASISWebReport <- function(projectname, rmHzErrors = FALSE, fill = FALSE,
}

#' @rdname fetchNASISWebReport
get_component_from_NASISWebReport <- function(projectname, stringsAsFactors = default.stringsAsFactors()) {

get_component_from_NASISWebReport <- function(projectname, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_component_from_NASISWebReport"

d.component <- lapply(projectname, function(x) {
Expand All @@ -114,7 +119,7 @@ get_component_from_NASISWebReport <- function(projectname, stringsAsFactors = de
return(NULL)

# set factor levels according to metadata domains
d.component <- uncode(d.component, db = "LIMS", stringsAsFactors = stringsAsFactors)
d.component <- uncode(d.component, db = "LIMS")

# prep
d.component <- .cogmd_prep(d.component, db = "LIMS")
Expand All @@ -127,8 +132,13 @@ get_component_from_NASISWebReport <- function(projectname, stringsAsFactors = de


#' @rdname fetchNASISWebReport
get_chorizon_from_NASISWebReport <- function(projectname, fill = FALSE, stringsAsFactors = default.stringsAsFactors()) {

get_chorizon_from_NASISWebReport <- function(projectname, fill = FALSE, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_chorizon_from_NASISWebReport"

d.chorizon <- lapply(projectname, function(x) {
Expand All @@ -147,7 +157,7 @@ get_chorizon_from_NASISWebReport <- function(projectname, fill = FALSE, stringsA
if (!all(is.na(d.chorizon$chiid))) {
d.chorizon <- within(d.chorizon, {
texture = tolower(texture)
if (stringsAsFactors == TRUE) {
if (getOption("stringsAsFactors", default = FALSE)) {
texcl = factor(texcl,
levels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceValue"],
labels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"]
Expand All @@ -169,8 +179,13 @@ get_chorizon_from_NASISWebReport <- function(projectname, fill = FALSE, stringsA


#' @rdname fetchNASISWebReport
get_legend_from_NASISWebReport <- function(mlraoffice, areasymbol, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors()) {

get_legend_from_NASISWebReport <- function(mlraoffice, areasymbol, droplevels = TRUE, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_legend_from_NASISWebReport"

args <- list(p_mlraoffice = mlraoffice, p_areasymbol = areasymbol)
Expand All @@ -182,8 +197,7 @@ get_legend_from_NASISWebReport <- function(mlraoffice, areasymbol, droplevels =
# data is coming back uncoded from LIMS so db is set to "SDA"
d.legend <- uncode(d.legend,
db = "SDA",
droplevels = droplevels,
stringsAsFactors = stringsAsFactors
droplevels = droplevels
)

# date
Expand All @@ -197,7 +211,13 @@ get_legend_from_NASISWebReport <- function(mlraoffice, areasymbol, droplevels =


#' @rdname fetchNASISWebReport
get_lmuaoverlap_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors()) {
get_lmuaoverlap_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_lmuaoverlap_from_NASISWebReport"

d <- lapply(areasymbol, function(x) {
Expand All @@ -212,8 +232,7 @@ get_lmuaoverlap_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, s
# data is coming back uncoded from LIMS so db is set to "SDA"
d <- uncode(d,
db = "SDA",
droplevels = droplevels,
stringsAsFactors = stringsAsFactors
droplevels = droplevels
)

# return data.frame
Expand All @@ -224,7 +243,13 @@ get_lmuaoverlap_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, s


#' @rdname fetchNASISWebReport
get_mapunit_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors()) {
get_mapunit_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_mapunit_from_NASISWebReport"

d.mapunit <- lapply(areasymbol, function(x) {
Expand All @@ -240,8 +265,7 @@ get_mapunit_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, strin
# data is coming back uncoded from LIMS so db is set to "SDA"
d.mapunit <- uncode(d.mapunit,
db = "SDA",
droplevels = droplevels,
stringsAsFactors = stringsAsFactors
droplevels = droplevels
)

# return data.frame
Expand All @@ -251,8 +275,13 @@ get_mapunit_from_NASISWebReport <- function(areasymbol, droplevels = TRUE, strin


#' @rdname fetchNASISWebReport
get_projectmapunit_from_NASISWebReport <- function(projectname, stringsAsFactors = default.stringsAsFactors()) {
get_projectmapunit_from_NASISWebReport <- function(projectname, stringsAsFactors = NULL) {

if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <-"https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_projectmapunit_from_NASISWebReport"


Expand All @@ -265,7 +294,7 @@ get_projectmapunit_from_NASISWebReport <- function(projectname, stringsAsFactors
d.mapunit$musym = as.character(d.mapunit$musym)

# set factor levels according to metadata domains
d.mapunit <- uncode(d.mapunit, db = "LIMS", stringsAsFactors = stringsAsFactors)
d.mapunit <- uncode(d.mapunit, db = "LIMS")

# return data.frame
return(d.mapunit)
Expand All @@ -274,8 +303,14 @@ get_projectmapunit_from_NASISWebReport <- function(projectname, stringsAsFactors


#' @rdname fetchNASISWebReport
get_projectmapunit2_from_NASISWebReport <- function(mlrassoarea, fiscalyear, projectname, stringsAsFactors = default.stringsAsFactors()) {
get_projectmapunit2_from_NASISWebReport <- function(mlrassoarea, fiscalyear, projectname, stringsAsFactors = NULL) {


if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

url <-"https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_projectmapunit2_from_NASISWebReport"

args = list(p_mlrassoarea = mlrassoarea, p_fy = fiscalyear, p_projectname = projectname)
Expand All @@ -285,7 +320,7 @@ get_projectmapunit2_from_NASISWebReport <- function(mlrassoarea, fiscalyear, pro

# set factor levels according to metadata domains
# data is coming back uncoded from LIMS so db is set to "SDA"
d.mapunit <- uncode(d.mapunit, db = "SDA", stringsAsFactors = stringsAsFactors)
d.mapunit <- uncode(d.mapunit, db = "SDA")

# return data.frame
return(d.mapunit)
Expand Down
15 changes: 10 additions & 5 deletions R/fetchNASIS_components.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,21 +6,26 @@
rmHzErrors = TRUE,
nullFragsAreZero = TRUE,
fill = FALSE,
stringsAsFactors = default.stringsAsFactors(),
stringsAsFactors = NULL,
dsn = NULL) {



if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

# ensure that any old hz errors are cleared
if(exists('component.hz.problems', envir=soilDB.env))
assign('component.hz.problems', value=character(0), envir=soilDB.env)

# load data in pieces
f.comp <- get_component_data_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn, nullFragsAreZero = nullFragsAreZero)
f.comp <- get_component_data_from_NASIS_db(SS = SS, dsn = dsn, nullFragsAreZero = nullFragsAreZero)
f.chorizon <- get_component_horizon_data_from_NASIS_db(SS = SS, fill = fill, dsn = dsn, nullFragsAreZero = nullFragsAreZero)
f.copm <- get_component_copm_data_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn)
f.copm <- get_component_copm_data_from_NASIS_db(SS = SS, dsn = dsn)
f.cogeomorph <- get_component_cogeomorph_data_from_NASIS_db2(SS = SS, dsn = dsn)
f.otherveg <- get_component_otherveg_data_from_NASIS_db(SS = SS, dsn = dsn)
f.ecosite <- get_component_esd_data_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn)
f.ecosite <- get_component_esd_data_from_NASIS_db(SS = SS, dsn = dsn)
f.diaghz <- get_component_diaghz_from_NASIS_db(SS = SS, dsn = dsn)
f.restrict <- get_component_restrictions_from_NASIS_db(SS = SS, dsn = dsn)

Expand Down
17 changes: 9 additions & 8 deletions R/fetchNASIS_pedons.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,15 @@
nullFragsAreZero = TRUE,
soilColorState = 'moist',
lab = FALSE,
stringsAsFactors = default.stringsAsFactors(),
stringsAsFactors = NULL,
dsn = NULL
) {


if (!missing(stringsAsFactors) && stringsAsFactors) {
.Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`")
NASISDomainsAsFactor(stringsAsFactors)
}

# test connection
if (!local_NASIS_defined(dsn) & !inherits(dsn, 'DBIConnection'))
stop('Local NASIS ODBC connection has not been set up. Please see `http://ncss-tech.github.io/AQP/soilDB/setup_local_nasis.html`.')
Expand All @@ -21,11 +26,8 @@

## load data in pieces
# these fail gracefully when no data in local DB | selected set
site_data <- get_site_data_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors,
dsn = dsn)
hz_data <- get_hz_data_from_NASIS_db(SS = SS, fill = fill,
stringsAsFactors = stringsAsFactors,
dsn = dsn)
site_data <- get_site_data_from_NASIS_db(SS = SS, dsn = dsn)
hz_data <- get_hz_data_from_NASIS_db(SS = SS, fill = fill, dsn = dsn)
color_data <- get_colors_from_NASIS_db(SS = SS, dsn = dsn)

## ensure there are enough data to create an SPC object
Expand Down Expand Up @@ -55,7 +57,6 @@

extended_data <- get_extended_data_from_NASIS_db(SS = SS,
nullFragsAreZero = nullFragsAreZero,
stringsAsFactors = stringsAsFactors,
dsn = dsn)

## fix some common problems
Expand Down
Loading

0 comments on commit 0d0c0cd

Please sign in to comment.