diff --git a/R/fetchHenry.R b/R/fetchHenry.R index 8e7b05da..a03f5a71 100644 --- a/R/fetchHenry.R +++ b/R/fetchHenry.R @@ -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 diff --git a/R/fetchNASIS.R b/R/fetchNASIS.R index a4ed0636..7de5654d 100644 --- a/R/fetchNASIS.R +++ b/R/fetchNASIS.R @@ -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 @@ -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 @@ -101,7 +103,6 @@ fetchNASIS <- function(from = 'pedons', nullFragsAreZero = nullFragsAreZero, soilColorState = soilColorState, lab = lab, - stringsAsFactors = stringsAsFactors, dsn = dsn) } @@ -111,7 +112,6 @@ fetchNASIS <- function(from = 'pedons', rmHzErrors = rmHzErrors, nullFragsAreZero = nullFragsAreZero, fill = fill, - stringsAsFactors = stringsAsFactors, dsn = dsn) } @@ -121,7 +121,6 @@ fetchNASIS <- function(from = 'pedons', rmHzErrors = rmHzErrors, nullFragsAreZero = nullFragsAreZero, soilColorState = soilColorState, - stringsAsFactors = stringsAsFactors ) } diff --git a/R/fetchNASISWebReport.R b/R/fetchNASISWebReport.R index fb5ea19c..e72b760b 100644 --- a/R/fetchNASISWebReport.R +++ b/R/fetchNASISWebReport.R @@ -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. @@ -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)) { @@ -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) { @@ -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") @@ -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) { @@ -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"] @@ -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) @@ -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 @@ -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) { @@ -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 @@ -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) { @@ -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 @@ -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" @@ -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) @@ -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) @@ -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) diff --git a/R/fetchNASIS_components.R b/R/fetchNASIS_components.R index f30ca5a0..e4089ef3 100644 --- a/R/fetchNASIS_components.R +++ b/R/fetchNASIS_components.R @@ -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) diff --git a/R/fetchNASIS_pedons.R b/R/fetchNASIS_pedons.R index fb31f7e0..6feaf2a8 100644 --- a/R/fetchNASIS_pedons.R +++ b/R/fetchNASIS_pedons.R @@ -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`.') @@ -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 @@ -55,7 +57,6 @@ extended_data <- get_extended_data_from_NASIS_db(SS = SS, nullFragsAreZero = nullFragsAreZero, - stringsAsFactors = stringsAsFactors, dsn = dsn) ## fix some common problems diff --git a/R/fetchNASIS_report.R b/R/fetchNASIS_report.R index 78de1918..52641e42 100644 --- a/R/fetchNASIS_report.R +++ b/R/fetchNASIS_report.R @@ -3,9 +3,14 @@ rmHzErrors = TRUE, nullFragsAreZero = TRUE, soilColorState = "moist", - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + tf <- "C:/ProgramData/USDA/NASIS/Temp/fetchNASIS.txt" if (!is.null(url)) tf <- url @@ -21,10 +26,8 @@ temp <- readLines(tf) be <- data.frame(table = c("site", "pediagfeatures", "phorizon", "phcolor"), - begin = grep("@begin", temp), - end = grep("@end", temp), - stringsAsFactors = stringsAsFactors - ) + begin = grep("@begin", temp), + end = grep("@end", temp)) # check to see if there is any data diff.idx <- be$end - be$begin @@ -131,8 +134,13 @@ # temp <- .fetchNASISTemp() -.get_site_from_NASISReport <- function(url = NULL, nullFragsAreZero = TRUE, stringsAsFactors = default.stringsAsFactors() +.get_site_from_NASISReport <- function(url = NULL, nullFragsAreZero = TRUE, stringsAsFactors = NULL ) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } tf = "C:/ProgramData/USDA/NASIS/Temp/get_site_from_NASIS.txt" if (!is.null(url)) tf = url @@ -174,9 +182,13 @@ -.get_pediagfeatures_from_NASISTemp <- function(stringsAsFactors = default.stringsAsFactors() -) { - +.get_pediagfeatures_from_NASISTemp <- function(stringsAsFactors = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + tf <- "C:/ProgramData/USDA/NASIS/Temp/get_pediagfeatures_from_NASIS.txt" # check if temp file exists @@ -189,8 +201,7 @@ readLines(tf) ), sep = "|", - quote = "", - stringsAsFactors = stringsAsFactors + quote = "" ) # aggregate NASIS returns empty rows # NASIS text reports return empty columns diff --git a/R/fetchOSD.R b/R/fetchOSD.R index 65ef0f0b..27c27641 100644 --- a/R/fetchOSD.R +++ b/R/fetchOSD.R @@ -200,7 +200,7 @@ fetchOSD <- function(soils, colorState='moist', extended=FALSE) { res <- try(jsonlite::fromJSON(final.url), silent = TRUE) # trap errors - if(inherits(res, 'try-error')) { + if (inherits(res, 'try-error')) { message(res[1]) return(NULL) } diff --git a/R/fetchVegdata.R b/R/fetchVegdata.R index bfe8646e..e176d313 100644 --- a/R/fetchVegdata.R +++ b/R/fetchVegdata.R @@ -10,12 +10,7 @@ #' get_vegplot_tree_si_summary_from_NASIS_db get_vegplot_trhi_from_NASIS_db #' #' @param SS fetch data from the currently loaded selected set in NASIS or from the entire local database (default: `TRUE`) -#' -#' @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` #' @@ -23,23 +18,27 @@ #' #' @export #' -fetchVegdata <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +fetchVegdata <- function(SS=TRUE, 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)) stop('Local NASIS ODBC connection has not been setup. Please see `http://ncss-tech.github.io/AQP/soilDB/setup_local_nasis.html`.') # 1. load data in pieces - vegplot <- get_vegplot_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegplotlocation <-get_vegplot_location_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegplotrhi <- get_vegplot_trhi_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegplotspecies <- get_vegplot_species_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegtransect <- get_vegplot_transect_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegtransplantsum <- get_vegplot_transpecies_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegsiteindexsum <- get_vegplot_tree_si_summary_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegsiteindexdet <- get_vegplot_tree_si_details_from_NASIS_db(SS = SS, stringsAsFactors = stringsAsFactors, dsn = dsn) - vegplottext <- get_vegplot_textnote_from_NASIS_db(SS = SS, fixLineEndings = TRUE, - stringsAsFactors = stringsAsFactors, dsn = dsn) + vegplot <- get_vegplot_from_NASIS_db(SS = SS, dsn = dsn) + vegplotlocation <-get_vegplot_location_from_NASIS_db(SS = SS, dsn = dsn) + vegplotrhi <- get_vegplot_trhi_from_NASIS_db(SS = SS, dsn = dsn) + vegplotspecies <- get_vegplot_species_from_NASIS_db(SS = SS, dsn = dsn) + vegtransect <- get_vegplot_transect_from_NASIS_db(SS = SS, dsn = dsn) + vegtransplantsum <- get_vegplot_transpecies_from_NASIS_db(SS = SS, dsn = dsn) + vegsiteindexsum <- get_vegplot_tree_si_summary_from_NASIS_db(SS = SS, dsn = dsn) + vegsiteindexdet <- get_vegplot_tree_si_details_from_NASIS_db(SS = SS, dsn = dsn) + vegplottext <- get_vegplot_textnote_from_NASIS_db(SS = SS, fixLineEndings = TRUE, dsn = dsn) # test to see if the selected set is loaded diff --git a/R/get_colors_from_NASIS_db.R b/R/get_colors_from_NASIS_db.R index ebdfb3fc..12bcb254 100644 --- a/R/get_colors_from_NASIS_db.R +++ b/R/get_colors_from_NASIS_db.R @@ -42,7 +42,7 @@ get_colors_from_NASIS_db <- function(SS = TRUE, dsn = NULL) { d <- dbQueryNASIS(channel, q) # uncode domained columns - d <- uncode(d, stringsAsFactors = FALSE, dsn = dsn) + d <- uncode(d, dsn = dsn) # convert back to characters / numeric d$colormoistst <- as.character(d$colormoistst) diff --git a/R/get_component_data_from_NASIS_db.R b/R/get_component_data_from_NASIS_db.R index 7f5d05f2..09c51466 100644 --- a/R/get_component_data_from_NASIS_db.R +++ b/R/get_component_data_from_NASIS_db.R @@ -10,11 +10,7 @@ #' @param SS fetch data from the currently loaded selected set in NASIS or from #' the entire local database (default: `TRUE`) #' @param nullFragsAreZero should surface fragment cover percentages of NULL be interpreted as 0? (default: TRUE) -#' @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 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 dsn Optional: path to local SQLite database containing NASIS #' table structure; default: `NULL` @@ -38,9 +34,13 @@ #' @export get_component_data_from_NASIS_db get_component_data_from_NASIS_db <- function(SS = TRUE, nullFragsAreZero = TRUE, - 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) + } + q1 <- "SELECT dmudesc, compname, comppct_r, compkind, majcompflag, localphase, drainagecl, hydricrating, elev_l, elev_r, elev_h, slope_l, slope_r, slope_h, aspectccwise, aspectrep, aspectcwise, map_l, map_r, map_h, airtempa_l as maat_l, airtempa_r as maat_r, airtempa_h as maat_h, soiltempa_r as mast_r, reannualprecip_r, ffd_l, ffd_r, ffd_h, tfact, wei, weg, nirrcapcl, nirrcapscl, nirrcapunit, irrcapcl, irrcapscl, irrcapunit, frostact, hydricrating, hydgrp, corcon, corsteel, taxclname, taxorder, taxsuborder, taxgrtgroup, taxsubgrp, taxpartsize, taxpartsizemod, taxceactcl, taxreaction, taxtempcl, taxmoistscl, taxtempregime, soiltaxedition, coiid, dmuiid FROM @@ -85,7 +85,7 @@ get_component_data_from_NASIS_db <- function(SS = TRUE, # uncode metadata domains if (nrow(d) > 0) { - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) ldx <- !d$coiid %in% chs$coiidref if (!any(ldx)) { @@ -172,9 +172,14 @@ get_component_restrictions_from_NASIS_db <- function(SS = TRUE, dsn = NULL) { get_component_correlation_data_from_NASIS_db <- function(SS = TRUE, dropAdditional = TRUE, dropNotRepresentative = TRUE, - 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) + } + q <- "SELECT lmapunitiid, mu.muiid, musym, nationalmusym, mu.muname, mukind, mutype, mustatus, muacres, farmlndcl, repdmu, dmuiid, areasymbol, areaname, ssastatus, cordate FROM mapunit_View_1 AS mu @@ -205,7 +210,7 @@ get_component_correlation_data_from_NASIS_db <- function(SS = TRUE, warning('there are no records in your selected set!', call. = FALSE) # recode metadata domains - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # optionally drop additional | NA mustatus if(dropAdditional) { @@ -311,10 +316,14 @@ get_component_cogeomorph_data_from_NASIS_db2 <- function(SS = TRUE, dsn = NULL) #' @export #' @rdname get_component_data_from_NASIS_db get_component_copm_data_from_NASIS_db <- function(SS = TRUE, - 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) + } + q <- "SELECT cpmg.coiidref as coiid, cpm.seqnum as seqnum, pmorder, pmdept_r, pmdepb_r, pmmodifier, pmgenmod, pmkind, pmorigin FROM @@ -337,7 +346,7 @@ get_component_copm_data_from_NASIS_db <- function(SS = TRUE, d <- dbQueryNASIS(channel, q) # uncode metadata domains - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # done return(d) @@ -347,9 +356,14 @@ get_component_copm_data_from_NASIS_db <- function(SS = TRUE, #' @export #' @rdname get_component_data_from_NASIS_db get_component_esd_data_from_NASIS_db <- function(SS = TRUE, - 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) + } + q <- "SELECT coiidref as coiid, ecositeid, ecositenm, ecositetype, ecositemlra, ecositelru, ecositenumber, ecositestate, repecosite, ecositepnm, ecositesnm, ecositetnm, ecositeidnew, ecositelrrnew, ecositemlranew, ecositelrunew, ecositenumbernew, ecositenasisiid @@ -381,7 +395,7 @@ get_component_esd_data_from_NASIS_db <- function(SS = TRUE, } # uncode metadata domains - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # done return(d) @@ -439,11 +453,7 @@ get_component_otherveg_data_from_NASIS_db <- function(SS = TRUE, dsn = NULL) { #' NA (FALSE) #' @param dsn Optional: path to local SQLite database containing NASIS #' table structure; default: `NULL` -#' @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 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 #' @return A list with the results. #' @author Stephen Roecker #' @seealso \code{\link{fetchNASIS}} @@ -463,9 +473,12 @@ get_component_otherveg_data_from_NASIS_db <- function(SS = TRUE, dsn = NULL) { #' @export get_comonth_from_NASIS_db get_comonth_from_NASIS_db <- function(SS = 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) + } q <- "SELECT coiidref AS coiid, month, flodfreqcl, floddurcl, pondfreqcl, ponddurcl, ponddep_l, ponddep_r, ponddep_h, dlyavgprecip_l, dlyavgprecip_r, dlyavgprecip_h, comonthiid FROM comonth_View_1 AS comonth;" @@ -484,7 +497,7 @@ get_comonth_from_NASIS_db <- function(SS = TRUE, d <- dbQueryNASIS(channel, q) # uncode metadata domains - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # optionally fill missing coiids if (fill) { diff --git a/R/get_component_from_GDB.R b/R/get_component_from_GDB.R index feacd9ed..a7379a33 100644 --- a/R/get_component_from_GDB.R +++ b/R/get_component_from_GDB.R @@ -1,4 +1,4 @@ -get_component_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, childs = FALSE, droplevels = TRUE, stringsAsFactors = TRUE) { +get_component_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, childs = FALSE, droplevels = TRUE, stringsAsFactors = NULL) { # check co_vars <- "comppct_l|comppct_r|comppct_h|compname|compkind|majcompflag|otherph|localphase|slope_l|slope_r|slope_h|slopelenusle_l|slopelenusle_r|slopelenusle_h|runoff|tfact|wei|weg|erocl|earthcovkind1|earthcovkind2|hydricon|hydricrating|drainagecl|elev_l|elev_r|elev_h|aspectccwise|aspectrep|aspectcwise|geomdesc|albedodry_l|albedodry_r|albedodry_h|airtempa_l|airtempa_r|airtempa_h|map_l|map_r|map_h|reannualprecip_l|reannualprecip_r|reannualprecip_h|ffd_l|ffd_r|ffd_h|nirrcapcl|nirrcapscl|nirrcapunit|irrcapcl|irrcapscl|irrcapunit|cropprodindex|constreeshrubgrp|wndbrksuitgrp|rsprod_l|rsprod_r|rsprod_h|foragesuitgrpid|wlgrain|wlgrass|wlherbaceous|wlshrub|wlconiferous|wlhardwood|wlwetplant|wlshallowwat|wlrangeland|wlopenland|wlwoodland|wlwetland|soilslippot|frostact|initsub_l|initsub_r|initsub_h|totalsub_l|totalsub_r|totalsub_h|hydgrp|corcon|corsteel|taxclname|taxorder|taxsuborder|taxgrtgroup|taxsubgrp|taxpartsize|taxpartsizemod|taxceactcl|taxreaction|taxtempcl|taxmoistscl|taxtempregime|soiltaxedition|castorieindex|flecolcomnum|flhe|flphe|flsoilleachpot|flsoirunoffpot|fltemik2use|fltriumph2use|indraingrp|innitrateleachi|misoimgmtgrp|vasoimgtgrp|cokey|mukey" @@ -26,8 +26,7 @@ get_component_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, chil # recode metadata domains co <- uncode(co, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) @@ -64,7 +63,7 @@ get_component_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, chil -get_legend_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplevels = TRUE, stringsAsFactors = TRUE, stats = FALSE) { +get_legend_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL, stats = FALSE) { if (!is.null(WHERE)) { # check @@ -93,8 +92,7 @@ get_legend_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplev # recode metadata domains le <- uncode(le, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) vars <- c("mlraoffice", "areasymbol", "areaname", "areatypename", "areaacres", "ssastatus", "projectscale", "cordate", "lkey", "n_mukey") @@ -110,7 +108,7 @@ get_legend_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplev -get_mapunit_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplevels = TRUE, stringsAsFactors = TRUE, stats = FALSE) { +get_mapunit_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL, stats = FALSE) { # tests if (!is.null(WHERE)) { @@ -217,8 +215,7 @@ get_mapunit_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, drople # recode metadata domains mu <- uncode(mu, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) vars <- c("areasymbol", "lkey", "mukey", "musym", "muname", "mukind", "mustatus", "invesintens", "muacres", "farmlndcl", "pct_component", "pct_hydric", "n_component", "n_majcompflag") @@ -389,8 +386,7 @@ get_mapunit_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, drople ch <- uncode(ch, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) return(ch) @@ -423,11 +419,7 @@ get_mapunit_from_GDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, drople #' @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. -#' @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 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 #' @return A \code{data.frame} or \code{SoilProfileCollection} object. #' @author Stephen Roecker #' @keywords manip @@ -460,7 +452,7 @@ fetchGDB <- function(dsn = "gNATSGO_CONUS.gdb", WHERE = NULL, childs = TRUE, droplevels = TRUE, - stringsAsFactors = TRUE + stringsAsFactors = NULL ) { # checks @@ -515,8 +507,7 @@ fetchGDB <- function(dsn = "gNATSGO_CONUS.gdb", dsn = dsn, WHERE = qry, childs = childs, - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels )) }, error = function(err) { @@ -553,8 +544,7 @@ fetchGDB <- function(dsn = "gNATSGO_CONUS.gdb", dsn = dsn, WHERE = WHERE, childs = childs, - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels )) # horizons diff --git a/R/get_component_from_SDA.R b/R/get_component_from_SDA.R index 183c82fb..477ae899 100644 --- a/R/get_component_from_SDA.R +++ b/R/get_component_from_SDA.R @@ -7,8 +7,13 @@ #' @rdname fetchSDA get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, droplevels = TRUE, nullFragsAreZero = TRUE, - stringsAsFactors = default.stringsAsFactors() - ) { + stringsAsFactors = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + if(!duplicates & grepl(WHERE, pattern = "mukey")[1]) warning("duplicates is set to FALSE and 'mukey' is in WHERE clause. Note: 'mukey' omitted from result.", call.=FALSE) @@ -59,8 +64,7 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR # recode metadata domains d.component <- uncode(d.component, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) # if mukeys are "flattened" to nmusym, make sure the mukey column _exists_ but is empty (NA) @@ -329,12 +333,16 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR #' @param mrulename character. Interpretation rule names get_cointerp_from_SDA <- function(WHERE = NULL, mrulename = NULL, duplicates = FALSE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) { - + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + d.component <- get_component_from_SDA(WHERE = WHERE, duplicates = duplicates, - childs = FALSE, - stringsAsFactors = stringsAsFactors + childs = FALSE ) q.cointerp <- paste0(" @@ -366,8 +374,7 @@ get_cointerp_from_SDA <- function(WHERE = NULL, mrulename = NULL, duplicates = F # recode metadata domains d.cointerp <- uncode(d.cointerp, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) return(d.cointerp) @@ -375,7 +382,7 @@ get_cointerp_from_SDA <- function(WHERE = NULL, mrulename = NULL, duplicates = F #' @export #' @rdname fetchSDA -get_legend_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors()) { +get_legend_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL) { q.legend <- paste(" SELECT mlraoffice, areasymbol, areaname, areatypename, CAST(areaacres AS INTEGER) AS areaacres, ssastatus, @@ -410,7 +417,7 @@ get_legend_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsFactor #' @export #' @rdname fetchSDA -get_lmuaoverlap_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors()) { +get_lmuaoverlap_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL) { q <- paste("SELECT legend.areasymbol, legend.areaname, legend.areaacres, @@ -443,8 +450,7 @@ get_lmuaoverlap_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsF # recode metadata domains d <- uncode(d, db = "NASIS", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) # done @@ -456,9 +462,13 @@ get_lmuaoverlap_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsF #' @rdname fetchSDA get_mapunit_from_SDA <- function(WHERE = NULL, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) { - + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + q.mapunit <- paste(" SELECT areasymbol, l.lkey, mukey, nationalmusym, musym, muname, @@ -493,8 +503,7 @@ get_mapunit_from_SDA <- function(WHERE = NULL, # recode metadata domains d.mapunit <- uncode(d.mapunit, db = "SDA", - droplevels = droplevels, - stringsAsFactors = stringsAsFactors + droplevels = droplevels ) @@ -514,8 +523,12 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, nullFragsAreZero = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } q.chorizon <- paste(" SELECT", @@ -565,12 +578,12 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, d.chorizon <- within(d.chorizon, { nationalmusym = NULL texture = tolower(texture) - if (stringsAsFactors == TRUE) { + if (getOption("stringsAsFactors", default = FALSE)) { texcl = factor(tolower(texcl), levels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"]) - } - if (droplevels == droplevels & is.factor(texcl)) { + } + if (droplevels == droplevels && is.factor(texcl)) { texcl = droplevels(texcl) - } + } }) # Note: only chtexturegrp$texdesc from SDA matches metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"] in metadata @@ -782,11 +795,7 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, #' @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. -#' @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 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 #' @return A data.frame or SoilProfileCollection object. #' @author Stephen Roecker #' @seealso \link{SDA_query} @@ -797,16 +806,20 @@ fetchSDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, nullFragsAreZero = TRUE, rmHzErrors = FALSE, droplevels = TRUE, - 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.component <- get_component_from_SDA(WHERE, duplicates = duplicates, childs = childs, droplevels = droplevels, - nullFragsAreZero = TRUE, - stringsAsFactors = stringsAsFactors + nullFragsAreZero = TRUE ) if (is.null(f.component)) { stop("WHERE clause returned no components.", call. = FALSE) @@ -818,7 +831,7 @@ fetchSDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, droplevels = droplevels ) # only query mapunit for mukeys in the component result - f.mapunit <- get_mapunit_from_SDA(paste('mu.nationalmusym IN', format_SQL_in_statement(unique(f.component$nationalmusym))), stringsAsFactors = stringsAsFactors) + f.mapunit <- get_mapunit_from_SDA(paste('mu.nationalmusym IN', format_SQL_in_statement(unique(f.component$nationalmusym)))) # diagnostic features and restrictions f.diag <- .get_diagnostics_from_SDA(f.component$cokey) diff --git a/R/get_concentrations_from_NASIS_db.R b/R/get_concentrations_from_NASIS_db.R index 2587559f..addc585e 100644 --- a/R/get_concentrations_from_NASIS_db.R +++ b/R/get_concentrations_from_NASIS_db.R @@ -1,5 +1,10 @@ -get_concentrations_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_concentrations_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # concentrations # unique-ness enforced via peiid (pedon-level) and phiid (horizon-level) q <- "SELECT peiid, phiid, @@ -32,8 +37,8 @@ get_concentrations_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default d.c <- dbQueryNASIS(channel, q.c) # uncode domained columns - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.c <- uncode(d.c, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) + d.c <- uncode(d.c, dsn = dsn) # convert back to characters / numeric d.c$colormoistst <- as.character(d.c$colormoistst) diff --git a/R/get_cosoilmoist_from_LIMS.R b/R/get_cosoilmoist_from_LIMS.R index ed66a142..9d126ed8 100644 --- a/R/get_cosoilmoist_from_LIMS.R +++ b/R/get_cosoilmoist_from_LIMS.R @@ -1,4 +1,9 @@ -get_cosoilmoist_from_NASISWebReport <- function(projectname, impute = TRUE, stringsAsFactors = default.stringsAsFactors()) { +get_cosoilmoist_from_NASISWebReport <- function(projectname, impute = TRUE, stringsAsFactors = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } # check for required packages url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_cosoimoist_from_NASISWebReport" @@ -13,7 +18,7 @@ get_cosoilmoist_from_NASISWebReport <- function(projectname, impute = TRUE, stri d.cosoilmoist <- uncode(d.cosoilmoist, db = "LIMS", stringsAsFactors = TRUE) # prep dataset: rename columns, impute empty values, stringsAsFactors - d.cosoilmoist <- .cosoilmoist_prep(d.cosoilmoist, impute = impute, stringsAsFactors = stringsAsFactors) + d.cosoilmoist <- .cosoilmoist_prep(d.cosoilmoist, impute = impute) # return data.fram return(d.cosoilmoist) diff --git a/R/get_cosoilmoist_from_NASIS.R b/R/get_cosoilmoist_from_NASIS.R index d732e616..3e2ddb27 100644 --- a/R/get_cosoilmoist_from_NASIS.R +++ b/R/get_cosoilmoist_from_NASIS.R @@ -13,11 +13,7 @@ #' @param impute replace missing (i.e. `NULL`) values with `"Not_Populated"` for #' categorical data, or the "RV" for numeric data or `201` cm if the "RV" is also #' `NULL` (default: `TRUE`) -#' @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 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 dsn Optional: path to local SQLite database containing NASIS #' table structure; default: `NULL` #' @return A data.frame. @@ -41,10 +37,15 @@ #' @export get_cosoilmoist_from_NASIS get_cosoilmoist_from_NASIS <- function(SS = TRUE, impute = TRUE, - 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) + } + q.cosoilmoist <- "SELECT dmuiidref AS dmuiid, coiid, compname, comppct_r, drainagecl, month, flodfreqcl, floddurcl, pondfreqcl, ponddurcl, cosoilmoistiid, soimoistdept_l, soimoistdept_r, soimoistdept_h, soimoistdepb_l, soimoistdepb_r, soimoistdepb_h, soimoiststat FROM component_View_1 co LEFT OUTER JOIN @@ -68,10 +69,10 @@ get_cosoilmoist_from_NASIS <- function(SS = TRUE, d.cosoilmoist <- dbQueryNASIS(channel, q.cosoilmoist) # recode metadata domains - d.cosoilmoist <- uncode(d.cosoilmoist, stringsAsFactors = stringsAsFactors, dsn = dsn) + d.cosoilmoist <- uncode(d.cosoilmoist, dsn = dsn) # prep dataset: rename columns, impute empty values, stringsAsFactors - d.cosoilmoist <- suppressWarnings(.cosoilmoist_prep(d.cosoilmoist, impute = impute, stringsAsFactors = stringsAsFactors)) + d.cosoilmoist <- suppressWarnings(.cosoilmoist_prep(d.cosoilmoist, impute = impute)) # done return(d.cosoilmoist) diff --git a/R/get_cosoilmoist_from_SDA.R b/R/get_cosoilmoist_from_SDA.R index e8b22e95..118db2ef 100644 --- a/R/get_cosoilmoist_from_SDA.R +++ b/R/get_cosoilmoist_from_SDA.R @@ -1,6 +1,12 @@ get_cosoilmoist_from_SDA <- function(WHERE = NULL, duplicates = FALSE, impute = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + q.cosoilmoist <- paste("SELECT", if (duplicates == FALSE) {"DISTINCT"} , "nationalmusym, muname, c.compname, c.comppct_r, drainagecl, month, flodfreqcl, pondfreqcl, soimoistdept_l, soimoistdept_r, soimoistdept_h, soimoistdepb_l, soimoistdepb_r, soimoistdepb_h, soimoiststat @@ -29,7 +35,7 @@ get_cosoilmoist_from_SDA <- function(WHERE = NULL, duplicates = FALSE, impute = d.cosoilmoist <- uncode(d.cosoilmoist, db = "SDA", stringsAsFactors = TRUE) # prep dataset: rename columns, impute empty values, stringsAsFactors - d.cosoilmoist <- .cosoilmoist_prep(d.cosoilmoist, impute = impute, stringsAsFactors = stringsAsFactors) + d.cosoilmoist <- .cosoilmoist_prep(d.cosoilmoist, impute = impute) # done return(d.cosoilmoist) diff --git a/R/get_extended_data_from_NASIS_db.R b/R/get_extended_data_from_NASIS_db.R index 2c115c3d..7a9db091 100644 --- a/R/get_extended_data_from_NASIS_db.R +++ b/R/get_extended_data_from_NASIS_db.R @@ -13,11 +13,8 @@ #' #' @param nullFragsAreZero should fragment volumes of NULL be interpreted as 0? #' (default: TRUE), see details -#' -#' @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` @@ -44,10 +41,14 @@ #' @export get_extended_data_from_NASIS_db get_extended_data_from_NASIS_db <- function(SS = TRUE, nullFragsAreZero = TRUE, - 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) + } + # photo links from PedonPC stored as sitetext notes q.photolink <- "SELECT so.siteiidref AS siteiid, sot.recdate, sot.textcat, CAST(sot.textentry AS text) AS imagepath FROM @@ -466,17 +467,17 @@ LEFT OUTER JOIN ( d.siteaoverlap <- dbQueryNASIS(channel, q.siteaoverlap, close = FALSE) ## uncode the ones that need that here - d.diagnostic <- uncode(d.diagnostic, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.restriction <- uncode(d.restriction, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.rf.data <- uncode(d.rf.data, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.art.data <- uncode(d.art.data, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.hz.texmod <- uncode(d.hz.texmod, stringsAsFactors = stringsAsFactors, dsn = dsn) + d.diagnostic <- uncode(d.diagnostic, dsn = dsn) + d.restriction <- uncode(d.restriction, dsn = dsn) + d.rf.data <- uncode(d.rf.data, dsn = dsn) + d.art.data <- uncode(d.art.data, dsn = dsn) + d.hz.texmod <- uncode(d.hz.texmod, dsn = dsn) # https://github.com/ncss-tech/soilDB/issues/53 - d.taxhistory <- uncode(d.taxhistory, stringsAsFactors = FALSE, dsn = dsn) - d.sitepm <- uncode(d.sitepm, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.structure <- uncode(d.structure, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.hz.desgn <- uncode(d.hz.desgn, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.hz.dessuf <- uncode(d.hz.dessuf, stringsAsFactors = stringsAsFactors, dsn = dsn) + d.taxhistory <- uncode(d.taxhistory, dsn = dsn, stringsAsFactors = FALSE) + d.sitepm <- uncode(d.sitepm, dsn = dsn) + d.structure <- uncode(d.structure, dsn = dsn) + d.hz.desgn <- uncode(d.hz.desgn, dsn = dsn) + d.hz.dessuf <- uncode(d.hz.dessuf, dsn = dsn) ## the following steps will not work when data are missing from local DB or SS # return NULL in those cases diff --git a/R/get_hz_data_from_NASIS_db.R b/R/get_hz_data_from_NASIS_db.R index 28217470..4c352042 100644 --- a/R/get_hz_data_from_NASIS_db.R +++ b/R/get_hz_data_from_NASIS_db.R @@ -9,11 +9,8 @@ #' @param SS fetch data from Selected Set in NASIS or from the entire local database (default: `TRUE`) #' #' @param fill include pedons 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` @@ -29,9 +26,13 @@ #' @export get_hz_data_from_NASIS_db get_hz_data_from_NASIS_db <- function(SS = 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) + } + q <- sprintf("SELECT peiid, phiid, upedonid as pedon_id, hzname, dspcomplayerid as genhz, hzdept, hzdepb, bounddistinct, boundtopo, @@ -66,7 +67,7 @@ get_hz_data_from_NASIS_db <- function(SS = TRUE, d <- dbQueryNASIS(channel, q) # uncode metadata domains - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # re-implement texture_class column, with lieutex in cases where texcl is missing d$texture_class <- ifelse(is.na(d$texcl) & ! is.na(d$lieutex), as.character(d$lieutex), as.character(d$texcl)) diff --git a/R/get_mapunit_from_NASIS.R b/R/get_mapunit_from_NASIS.R index 2315b5ff..b5125b75 100644 --- a/R/get_mapunit_from_NASIS.R +++ b/R/get_mapunit_from_NASIS.R @@ -3,15 +3,17 @@ #' #' @param SS fetch data from the currently loaded selected set in NASIS or from the entire local database (default: `TRUE`) #' @param droplevels Drop unused levels from `farmlndcl` and other factor levels from NASIS domains? -#' @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` #' #' @export -get_mapunit_from_NASIS <- function(SS = TRUE, droplevels = TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_mapunit_from_NASIS <- function(SS = TRUE, droplevels = TRUE, stringsAsFactors = NULL, dsn = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } q.mapunit <- paste(" SELECT @@ -72,7 +74,6 @@ get_mapunit_from_NASIS <- function(SS = TRUE, droplevels = TRUE, stringsAsFactor d.mapunit <- uncode(d.mapunit, db = "NASIS", droplevels = droplevels, - stringsAsFactors = stringsAsFactors, dsn = dsn) # hacks to make R CMD check --as-cran happy: @@ -108,8 +109,12 @@ get_mapunit_from_NASIS <- function(SS = TRUE, droplevels = TRUE, stringsAsFactor #' @rdname get_mapunit_from_NASIS get_legend_from_NASIS <- function(SS = TRUE, droplevels = TRUE, - 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) + } q.legend <- paste(" SELECT @@ -151,7 +156,6 @@ get_legend_from_NASIS <- function(SS = TRUE, d.legend <- uncode(d.legend, db = "NASIS", droplevels = droplevels, - stringsAsFactors = stringsAsFactors, dsn = dsn) # done @@ -164,7 +168,7 @@ get_legend_from_NASIS <- function(SS = TRUE, #' @rdname get_mapunit_from_NASIS get_lmuaoverlap_from_NASIS <- function(SS = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL) { q <- "SELECT @@ -216,7 +220,6 @@ get_lmuaoverlap_from_NASIS <- function(SS = TRUE, d <- uncode(d, db = "NASIS", droplevels = droplevels, - stringsAsFactors = stringsAsFactors, dsn = dsn) # done diff --git a/R/get_phfmp_from_NASIS_db.R b/R/get_phfmp_from_NASIS_db.R index 39771f07..9622bcc4 100644 --- a/R/get_phfmp_from_NASIS_db.R +++ b/R/get_phfmp_from_NASIS_db.R @@ -1,6 +1,10 @@ -get_phfmp_from_NASIS_db <- function(SS = TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { - +get_phfmp_from_NASIS_db <- function(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # because of alias with fetchNASIS cannot allow setting attr # also, attr is a free-form field, so not terribly useful -- consider SQL LIKE? @@ -25,5 +29,5 @@ get_phfmp_from_NASIS_db <- function(SS = TRUE, stringsAsFactors = default.string d <- dbQueryNASIS(channel, q) # field measured properties, long format - return(uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn)) + return(uncode(d, dsn = dsn)) } diff --git a/R/get_projectmapunit_from_NASIS.R b/R/get_projectmapunit_from_NASIS.R index 3d343cee..03745093 100644 --- a/R/get_projectmapunit_from_NASIS.R +++ b/R/get_projectmapunit_from_NASIS.R @@ -1,7 +1,12 @@ #' @export #' @rdname get_mapunit_from_NASIS -get_projectmapunit_from_NASIS <- function(SS = TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_projectmapunit_from_NASIS <- function(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + q <- paste("SELECT p.projectiid, p.uprojectid, p.projectname, pmu.seqnum pmu_seqnum, a2.areasymbol, lmu.musym, lmu.lmapunitiid AS mukey, mu.nationalmusym, mutype, lmu.mustatus, muname, muacres FROM @@ -38,7 +43,7 @@ get_projectmapunit_from_NASIS <- function(SS = TRUE, stringsAsFactors = default. if (nrow(d.project) == 0) message("your selected set is missing the project table, please load it and try again") # uncode metadata domains - d.project <- uncode(d.project, stringsAsFactors = stringsAsFactors, dsn = dsn) + d.project <- uncode(d.project, dsn = dsn) # done return(d.project) diff --git a/R/get_site_data_from_NASIS_db.R b/R/get_site_data_from_NASIS_db.R index 436f6868..a6e385f5 100644 --- a/R/get_site_data_from_NASIS_db.R +++ b/R/get_site_data_from_NASIS_db.R @@ -26,11 +26,8 @@ #' database (default: `TRUE`) #' #' @param nullFragsAreZero should surface fragment cover percentages of NULL be interpreted as 0? (default: TRUE) -#' -#' @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` @@ -44,9 +41,13 @@ #' @export get_site_data_from_NASIS_db get_site_data_from_NASIS_db <- function(SS = TRUE, nullFragsAreZero = TRUE, - 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) + } + q <- "SELECT siteiid as siteiid, peiid, CAST(usiteid AS varchar(60)) as site_id, CAST(upedonid AS varchar(60)) as pedon_id, obsdate as obs_date, utmzone, utmeasting, utmnorthing, -(longdegrees + CASE WHEN longminutes IS NULL THEN 0.0 ELSE longminutes / 60.0 END + CASE WHEN longseconds IS NULL THEN 0.0 ELSE longseconds / 60.0 / 60.0 END) as x, latdegrees + CASE WHEN latminutes IS NULL THEN 0.0 ELSE latminutes / 60.0 END + CASE WHEN latseconds IS NULL THEN 0.0 ELSE latseconds / 60.0 / 60.0 END as y, horizdatnm, longstddecimaldegrees as x_std, latstddecimaldegrees as y_std, gpspositionalerror, descname as describer, pedonpurpose, pedontype, pedlabsampnum, labdatadescflag, @@ -95,7 +96,7 @@ ORDER BY pedon_View_1.peiid ;" stop('error in SQL') # uncode domain columns - d <- uncode(d, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d, dsn = dsn) # surface fragments sfr <- dbQueryNASIS(channel, q2) @@ -174,14 +175,6 @@ ORDER BY pedon_View_1.peiid ;" ss.levels <- apply(ss.grid, 1, function(i) { paste(rev(i), collapse = ' / ')}) d2$slope_shape <- factor(d2$slope_shape, levels = ss.levels) - # convert factors to strings - # 2021-11-05: this code was unreachable; "df" not defined - - # idx <- unlist(lapply(d2, is.factor)) - # if (stringsAsFactors == FALSE & any(idx)) { - # d2[idx] <- lapply(d2[idx], as.character) - # } - # done return(d2) } diff --git a/R/get_soilseries_from_NASIS.R b/R/get_soilseries_from_NASIS.R index c2333dc3..ffaf4ca6 100644 --- a/R/get_soilseries_from_NASIS.R +++ b/R/get_soilseries_from_NASIS.R @@ -5,11 +5,7 @@ #' only). #' #' @aliases get_soilseries_from_NASIS get_soilseries_from_NASISWebReport -#' -#' @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 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` #' @@ -22,8 +18,13 @@ #' @keywords manip #' #' @export get_soilseries_from_NASIS -get_soilseries_from_NASIS <- function(stringsAsFactors = default.stringsAsFactors(), +get_soilseries_from_NASIS <- function(stringsAsFactors = NULL, dsn = NULL, delimiter = " over ") { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + q.soilseries <- " SELECT soilseriesname, soilseriesstatus, benchmarksoilflag, soiltaxclasslastupdated, mlraoffice, taxclname, taxorder, taxsuborder, taxgrtgroup, taxsubgrp, taxpartsize, taxpartsizemod, taxceactcl, taxreaction, taxtempcl, taxfamhahatmatcl, originyear, establishedyear, descriptiondateinitial, descriptiondateupdated, statsgoflag, soilseriesiid, areasymbol, areaname, areaacres, obterm, areatypename, soilseriesedithistory FROM soilseries ss @@ -44,8 +45,8 @@ get_soilseries_from_NASIS <- function(stringsAsFactors = default.stringsAsFactor d.soilseriesmin <- dbQueryNASIS(channel, q.min) # recode metadata domains - d.soilseries <- uncode(d.soilseries, stringsAsFactors = stringsAsFactors, dsn = dsn) - d.soilseriesmin <- uncode(d.soilseriesmin, stringsAsFactors = stringsAsFactors, dsn = dsn) + d.soilseries <- uncode(d.soilseries, dsn = dsn) + d.soilseriesmin <- uncode(d.soilseriesmin, dsn = dsn) # prep d.soilseries$soiltaxclassyearlastupdated <- format(as.Date(d.soilseries$soiltaxclasslastupdated), "%Y") @@ -75,8 +76,13 @@ get_soilseries_from_NASIS <- function(stringsAsFactors = default.stringsAsFactor "areaacres", "obterm", "areatypename")]) } -get_soilseries_from_NASISWebReport <- function(soils, stringsAsFactors = default.stringsAsFactors()) { +get_soilseries_from_NASISWebReport <- function(soils, 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_soilseries_from_NASISWebReport" d.ss <- lapply(soils, function(x) { @@ -87,10 +93,10 @@ get_soilseries_from_NASISWebReport <- function(soils, stringsAsFactors = default # set factor levels according to metadata domains d.ss[!names(d.ss) %in% c("mlraoffice", "taxminalogy")] <- uncode(d.ss[!names(d.ss) %in% c("mlraoffice", "taxminalogy")], - db = "SDA", stringsAsFactors = stringsAsFactors) + db = "SDA") d.ss[names(d.ss) %in% c("mlraoffice")] <- uncode(d.ss[names(d.ss) %in% c("mlraoffice")], - db = "LIMS", stringsAsFactors = stringsAsFactors) + db = "LIMS") # return data.frame return(d.ss) diff --git a/R/get_vegplot_data_from_NASIS_db.R b/R/get_vegplot_data_from_NASIS_db.R index 755ff16c..4a3049e6 100644 --- a/R/get_vegplot_data_from_NASIS_db.R +++ b/R/get_vegplot_data_from_NASIS_db.R @@ -3,9 +3,14 @@ #' @export #' @rdname fetchVegdata get_vegplot_from_NASIS_db <- function(SS = TRUE, - 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) + } + q.vegplot <- "SELECT siteiid, p.peiid, usiteid as site_id, assocuserpedonid as pedon_id, v.vegplotid as vegplot_id, vegplotiid, vegplotname, obsdate, primarydatacollector, datacollectionpurpose, vegdataorigin, vegplotsize, soilprofileindicator, soil232idlegacy, ahorizondepth, alkalinesalineindicator, alkalineaffected, salinityclass, restrictivelayerdepthlegacy, legacysoilcompname, legacysoilphase, legacylocalsoilphase, legacysoilsurftext, legacysurftextmod, legacyterminlieu, erosionclasslegacy, landformgrouplegacy, cryptogamcovcllegacy, rangelandusehistory, cancovpctplotave, cancovtotalpct, cancovtotalclass, overstorycancontotalpct, overstorycancovtotalclass, dblsampannualprodave, compyieldproductionave, abovegroundbiomasstotave, understoryreprodabundance, woodyunderstoryabundance, herbundertoryabundance, lichensunderstoryabundance, crowncanclosurepct, crowncancloseassessmethod, crowncompfactorlpp, crowncomplppavedbh, basalcoverpctave, basalareaplottotal, basalareaassessmethod, constreeshrubgrp, windbreakrowonedirection, windbreaktrappedsoildepth, windbreaktrappedsoiltexture, understorydescindicator, mensurationdataindicator, vigorclasslegacy, siteconditionlegacy, overstoryspecieslegacy, plantmoiststate, currenttreedensity, currenttreespacing, currentdxspacing, currentplotavedbh, plotbasalareafactor, currentbasalarea, foreststandtype, foreststratainventoried, foreststandregen, foreststandquality, desiredtreedensity, desireddxspacing, desiredbasalarea, excessbasalarea, excesstreedensity, stockingchangepct, treepctgoodcondition, treepctfaircondition, treepctpoorcondition, treecounttotal, treesnagdensityhard, treesnagdensitysoft, pastureforagetype, pasturestanddensityave, pastureplanthtave, pastureprodave, pcidesirableplants, pciplantcover, pciplantdiversity, pcigroundcovresidue, pcistandingdeadforage, pciplantresiduecompscore, pciplantvigor, pcilegumepctclass, pciuseuniformity, pcilivestockconcareas, pcisoilcompaction, pcisheetrillerosion, pciwinderosion, pcistreamshoreerosion, pcigullyerosion, pcierosioncompscore, pcipastureconditionscore, refplantcommunity, repannualprod, totestannualprod, totallowableannualprod, totpalatableannualprod, similarityindex, annualuseableprod, harvesteffpct, takehalfleavehalf, acresperaum, aumperacre, audperacre, desirableplantvigor, desirableseedlingabundance, decadentplantabundance, plantresidueadequacy, undesirableinvadingspecies, majorinvadingspecies, invadingspeciescancovpct, soilsurferosion, soilcrusting, soilcompaction, baregroundpct, gullyrillpresence, soildegradationrating, rangetrendcurrent, rangetrendplanned, qcreviewperson, qcreviewdate, qareviewperson, qareviewdate, swcdlegacy, fieldofficelegacy, nrcsarealegacy, aktotallichencoverpct, aktotallitter1coverpct, aktotallitter2coverpct, aktotalmosscoverpct, aktotalrockcoverpct, aktotalsoilcoverpct, aktotalwatercoverpct, akecologicalsitestatus, aktotalbedrockcoverpct, akfieldecositeid FROM site_View_1 AS s @@ -38,7 +43,7 @@ get_vegplot_from_NASIS_db <- function(SS = TRUE, stop('No NASIS Site+Vegetation Plot records in ', ds, '!', call. = FALSE) } # uncode metadata domains - d <- uncode(d.vegplot, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegplot, dsn = dsn) # done return(d) @@ -48,8 +53,14 @@ get_vegplot_from_NASIS_db <- function(SS = TRUE, # get location data from the corresponding record in the site table #' @export #' @rdname fetchVegdata -get_vegplot_location_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_vegplot_location_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # query the coordinate, plss description, and site characteristics data for these records from the site table q.plotlocation <- "SELECT s.siteiid, s.usiteid as site_id, v.vegplotid as vegplot_id, vegplotiid, so.obsdate, v.datacollectionpurpose, latdegrees, latminutes, latseconds, latdir, longdegrees, longminutes, longseconds, longdir, horizdatnm, plsssection, plsstownship, plssrange, plssmeridian, utmzone, utmnorthing, utmeasting, latstddecimaldegrees, longstddecimaldegrees, geocoordsource, elev, slope, aspect, CAST(plsssdetails as text) AS plsssdetails, CAST(locdesc as text) AS locdesc FROM @@ -69,10 +80,10 @@ get_vegplot_location_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defau } # exec query - d.plotlocation <- dbQueryNASIS(channel, q.plotlocation, stringsAsFactors = FALSE) + d.plotlocation <- dbQueryNASIS(channel, q.plotlocation) # uncode metadata domains - d <- uncode(d.plotlocation, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.plotlocation, dsn = dsn) # # test for no data # if (nrow(d) == 0) @@ -108,8 +119,13 @@ get_vegplot_location_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defau # get Rangeland Health Indicator(RHI) associated fields in the vegplot table #' @export #' @rdname fetchVegdata -get_vegplot_trhi_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_vegplot_trhi_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + q.vegplotrhi <- "SELECT siteiid, p.peiid, usiteid as site_id, assocuserpedonid as pedon_id, v.vegplotid as vegplot_id, vegplotiid, vegplotname, obsdate, rhiannualprod, rhibareground, rhicompactionlayer, rhifuncstructgroups, rhierosionresistance, rhigullies, rhirills, rhipedastalsterracettes, rhiinfilrunoff, rhilitteramount, rhilittermovement, rhiplantmortality, rhireprodcapability, rhiinvasiveplants, rhisoilsurfdegradation, rhiwaterflowpatterns, rhiwindscourareas, rhisoilsitestabsumm, rhibioticintegritysumm, rhihydrofunctionsumm FROM site_View_1 AS s @@ -132,7 +148,7 @@ get_vegplot_trhi_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.s d.vegplotrhi <- dbQueryNASIS(channel, q.vegplotrhi) # uncode metadata domains - d <- uncode(d.vegplotrhi, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegplotrhi, dsn = dsn) # # test for no data # if (nrow(d) == 0) { @@ -172,7 +188,7 @@ get_vegplot_species_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defaul d.vegplotspecies <- dbQueryNASIS(channel, q.vegplotspecies) # uncode metadata domains - d <- uncode(d.vegplotspecies, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegplotspecies, dsn = dsn) # # test for no data # if (nrow(d) == 0) { @@ -187,8 +203,13 @@ get_vegplot_species_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defaul # get vegplot transect data #' @export #' @rdname fetchVegdata -get_vegplot_transect_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { - +get_vegplot_transect_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # veg transect data - many transects to one vegplot q.vegtransect <- "SELECT siteiid, p.peiid, vegplotiidref, vegtransectiid, usiteid as site_id, assocuserpedonid as pedon_id, vegplotid as vegplot_id, vegplotname, vegtransectid as vegtransect_id, obsdate, primarydatacollector, datacollectionpurpose, transectstartlatitude, transectstartlongitude, transectendlatitude, transectendlongitude, transectazimuth, transectlength, transectstartelevation, transectendelevation, dblsampquadratssampled, dblsampquadratsclipped, nestedfreqquadratssampled, freqquadratssampled, dwrquadratssampled, daubenmirequadratssampled, quadratsizedomlegacy, quadratsizeseclegacy, quadratshapedomlegacy, quadratshapeseclegacy, beltwidth, dblsampannualprod, totharvestannualprod, wtunitannualprod, dwrannualprod, comparativeyieldprod, comparativeyieldranktotal, comparativeyieldrankave, comparativerefclipwtave, abovegroundbiomasstotal, standingherbbiomass, transectbasalcovpct, basalcovpcttotal, basalgapsizemin, canopygapsizemin, gapsmeasuredbetween, canopygaplengthtotal, canopygappcttotal, basalgaplengthtotal, basalgappcttotal, vt.understoryreprodabundance, vt.woodyunderstoryabundance, vt.herbundertoryabundance, vt.lichensunderstoryabundance, cancovpcttotaltrans, cancovtotalclasstrans, cancovassessmethod, vt.crowncanclosurepct, vt.crowncancloseassessmethod, vt.crowncompfactorlpp, vt.crowncomplppavedbh, overstorycancovpcttrans, overstorycancovclasstrans, groundcovassessmethod, groundcovquadratssampled, groundcovpointssampled, groundsurfcovassessmethod, groundsurfcovquadratsamp, groundsurfcovpointssamp, lpiobsinterval, totalpointssampledcount, topcanopyhtave, topcanopyhtstddev, totalnumplantsbelt, totalnumspeciesbelt, totalplantdensitybelt FROM @@ -218,7 +239,7 @@ get_vegplot_transect_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defau # } # uncode metadata domains - d <- uncode(d.vegtransect, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegtransect, dsn = dsn) # done return(d) @@ -228,8 +249,13 @@ get_vegplot_transect_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = defau # get vegplot transect species data #' @export #' @rdname fetchVegdata -get_vegplot_transpecies_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_vegplot_transpecies_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # veg transect species data - many species to one veg transect q.vtps <- "SELECT siteiid, vegtransectiidref as vegtransect_id, vegplotid, vegplotname, obsdate, vegtransplantsummiid as vtpsiid, vtps.seqnum, plantsym, plantsciname, plantnatvernm, plantnativity, planttypegroup, plantheightcllowerlimit, plantheightclupperlimit, sociabilityclass, specieslivecanhtbotave, specieslivecanhttopave, overstorydbhmin, overstorydbhmax, speciesovercancovpct, speciesovercancovclass, plantprodquadratsize, plantprodquadratshape, nestedfreqquadratsize, nestedfreqquadratshape, frequencyquadratsize, frequencyquadratshape, dwrquadratsize, dwrquadratshape, densityquadratsize, densityquadratshape, speciestotwtclippedest, speciestotwtclippedfresh, speciestotwtclippedairdry, speciestotwtairdry, speciestotwtest, speciestotwtexisting, speciesdrywtpct, speciestotwt, speciesaveyielddblsamp, speciescomppctdblsamp, speciescomppctdaubenmire, speciescomppctlineintercept, speciestraceamtflag, weightconvfactor, dblsampcorrectionfactor, airdrywtadjustment, utilizationadjustment, growthadjustment, weatheradjustment, numberofquadratsin, speciesfreqdaubenmire, dwronetally, dwrtwotally, dwrthreetally, dwrweightedtally, speciescomppctdwr, speciesaveyielddwr, wtunitweight, wtunitcounttotal, speciesaveyieldwtunit, wtunitwtclippedtotal, speciescancovhitcount, speciescancovpct, speciescancovpctavedaub, speciescancovaveclass, speciesfoliarcovhitcount, speciesfoliarcovpctlineint, speciestotfoliarcovlineint, speciesbasalcovhitcount, speciesbasalcovpctlineint, speciestotbasalcovlineint, maturecounttotal, maturedensityave, maturedensityaveclass, seedlingcounttotal, seedlingdensityave, seedlingdensityaveclass, speciesgroundcovabundclass, speciescancovportion, speciesbasalarea, vtps.basalareaassessmethod FROM @@ -259,7 +285,7 @@ get_vegplot_transpecies_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = de # stop('there are no NASIS vegplots transect species in your selected set!') # uncode metadata domains - d <- uncode(d.vegtransplantsum, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegtransplantsum, dsn = dsn) # done return(d) @@ -268,8 +294,14 @@ get_vegplot_transpecies_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = de # get vegplot tree site index summary data #' @export #' @rdname fetchVegdata -get_vegplot_tree_si_summary_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { +get_vegplot_tree_si_summary_from_NASIS_db <- function(SS=TRUE, stringsAsFactors = NULL, dsn = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # plot tree site index summary data q.pltsis <- "SELECT vegplotiidref AS vegplotiid, pltsis.seqnum, plantiidref, plantsym, plantsciname, plantnatvernm, plantnativity, siteindexbase, speciestreecount, siteindexplotave, speciesdbhaverage, treeageave, treecanopyhttopave, plottreesiteindsumiid @@ -299,7 +331,7 @@ get_vegplot_tree_si_summary_from_NASIS_db <- function(SS=TRUE, stringsAsFactors # stop('there are no NASIS vegplots tree site index data in your selected set!', call. = FALSE) # uncode metadata domains - d <- uncode(d.vegsiteindexsum, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegsiteindexsum, dsn = dsn) # done return(d) @@ -343,7 +375,7 @@ get_vegplot_tree_si_details_from_NASIS_db <- function(SS=TRUE, stringsAsFactors # } # uncode metadata domains - d <- uncode(d.vegsiteindexdet, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegsiteindexdet, dsn = dsn) # done return(d) @@ -354,8 +386,13 @@ get_vegplot_tree_si_details_from_NASIS_db <- function(SS=TRUE, stringsAsFactors #' @param fixLineEndings Replace `'\r\n'` with `'\n'`; Default: `TRUE` #' @export #' @rdname fetchVegdata -get_vegplot_textnote_from_NASIS_db <- function(SS=TRUE, fixLineEndings=TRUE, stringsAsFactors = default.stringsAsFactors(), dsn = NULL) { - +get_vegplot_textnote_from_NASIS_db <- function(SS=TRUE, fixLineEndings=TRUE, stringsAsFactors = NULL, dsn = NULL) { + + if (!missing(stringsAsFactors) && stringsAsFactors) { + .Deprecated(msg = "stringsAsFactors = TRUE argument is deprecated.\nSetting package option with `NASISDomainsAsFactor(TRUE)`") + NASISDomainsAsFactor(stringsAsFactors) + } + # vegplot textnotes q.vegplottext <- "SELECT vegplotiidref as vegplotiid, seqnum, recdate, recauthor, vegplottextkind, textcat, textsubcat, vegplottextiid, CAST(textentry as text) AS textentry @@ -379,7 +416,7 @@ FROM vegplottext_View_1;" # stop('there are no NASIS vegplots textnotes in your selected set!', call. = FALSE) # uncode metadata domains - d <- uncode(d.vegplottext, stringsAsFactors = stringsAsFactors, dsn = dsn) + d <- uncode(d.vegplottext, dsn = dsn) # optionally convert \r\n -> \n if (fixLineEndings) { diff --git a/R/uncode.R b/R/uncode.R index eeafb8f6..e1992b56 100644 --- a/R/uncode.R +++ b/R/uncode.R @@ -44,8 +44,7 @@ #' classifying factors. This is useful when a class has large number of unused #' classes, which can waste space in tables and figures. #' -#' @param stringsAsFactors logical: should character vectors be converted to -#' factors? +#' @param stringsAsFactors deprecated #' #' @param dsn Optional: path to local SQLite database containing NASIS #' table structure; default: `NULL` @@ -74,9 +73,14 @@ uncode <- function(df, invert = FALSE, db = "NASIS", droplevels = 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) + } + # load current metadata table if (db == "NASIS") { metadata <- .get_NASIS_metadata(dsn = dsn) @@ -97,45 +101,45 @@ uncode <- function(df, columnsToWorkOn.idx <- which(nm %in% possibleReplacements) # iterate over columns with codes - for (i in columnsToWorkOn.idx){ - + for (i in columnsToWorkOn.idx) { # get the current metadata - sub <- metadata[metadata[[metadata_col]] %in% nm[i], ] - + sub <- metadata[metadata[[metadata_col]] %in% nm[i],] + # NASIS or LIMS if (db %in% c("NASIS", "LIMS")) { - if (invert == FALSE){ + if (invert == FALSE) { # replace codes with values df[, i] <- factor(df[, i], levels = sub[[value_col]], labels = sub[[name_col]]) } else { # replace values with codes - df[, i] <- factor(df[, i], levels = sub[[name_col]], labels = sub[[value_col]])} + df[, i] <- factor(df[, i], levels = sub[[name_col]], labels = sub[[value_col]]) + } } # SDA if (db == "SDA") { - if (invert == FALSE){ + if (invert == FALSE) { # replace codes with values df[, i] <- factor(df[, i], levels = sub[[label_col]]) } else { # replace values with codes df[, i] <- factor(df[, i], levels = sub[[label_col]], labels = sub[[value_col]]) - } } } + } # drop unused levels if (droplevels == TRUE) { - idx <- which(! nm %in% possibleReplacements) + idx <- which(!nm %in% possibleReplacements) df <- droplevels(df, except = idx) - } + } - # convert factors to strings - if (stringsAsFactors == FALSE) { + # convert factors to strings, check soilDB option first + if (!getOption("soilDB.NASIS.NASISDomainsAsFactor", default = FALSE) || !stringsAsFactors){ idx <- unlist(lapply(df, is.factor)) df[idx] <- lapply(df[idx], as.character) } - + return(df) } @@ -167,4 +171,22 @@ code <- function(df, ...) { return(res) } +#' Get/Set Options for Encoding NASIS Domains as Factors +#' +#' Set package option `soilDB.NASIS.DomainsAsFactor` for returning coded NASIS domains as factors. +#' +#' @param x logical; default `FALSE` +#' +#' @return local, result of `getOption("soilDB.NASIS.DomainsAsFactor")` +#' @export +#' +#' @examples +#' \dontrun{ +#' NASISDomansAsFactor(TRUE) +#' } +NASISDomainsAsFactor <- function(x = FALSE) { + options(soilDB.NASIS.DomainsAsFactor = getOption("stringsAsFactors", + default = FALSE) || x) + getOption("soilDB.NASIS.DomainsAsFactor", default = FALSE) +} diff --git a/R/utils.R b/R/utils.R index ce2f0ab8..a122c5e5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -785,7 +785,7 @@ # convert factors to strings idx <- unlist(lapply(df, is.factor)) - if (stringsAsFactors == FALSE & any(idx)) { + if (any(idx)) { df[idx] <- lapply(df[idx], as.character) } diff --git a/man/NASISDomainsAsFactor.Rd b/man/NASISDomainsAsFactor.Rd new file mode 100644 index 00000000..9986d665 --- /dev/null +++ b/man/NASISDomainsAsFactor.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/uncode.R +\name{NASISDomainsAsFactor} +\alias{NASISDomainsAsFactor} +\title{Get/Set Options for Encoding NASIS Domains as Factors} +\usage{ +NASISDomainsAsFactor(x = FALSE) +} +\arguments{ +\item{x}{logical; default \code{FALSE}} +} +\value{ +local, result of \code{getOption("soilDB.NASIS.DomainsAsFactor")} +} +\description{ +Set package option \code{soilDB.NASIS.DomainsAsFactor} for returning coded NASIS domains as factors. +} +\examples{ +\dontrun{ +NASISDomansAsFactor(TRUE) +} +} diff --git a/man/fetchGDB.Rd b/man/fetchGDB.Rd index 20b145f9..35a255b9 100644 --- a/man/fetchGDB.Rd +++ b/man/fetchGDB.Rd @@ -12,7 +12,7 @@ fetchGDB( WHERE = NULL, childs = TRUE, droplevels = TRUE, - stringsAsFactors = TRUE + stringsAsFactors = NULL ) } \arguments{ @@ -31,11 +31,7 @@ are not flattened and appended} classifying factors. This is useful when a class has large number of unused classes, which can waste space in tables and figures.} -\item{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 set outside of uncode() (i.e. hard coded). -The 'factory-fresh' default is TRUE, but this can be changed by setting -options(stringsAsFactors = FALSE)} +\item{stringsAsFactors}{deprecated} } \value{ A \code{data.frame} or \code{SoilProfileCollection} object. diff --git a/man/fetchNASIS.Rd b/man/fetchNASIS.Rd index e10e3cb1..e360e22f 100644 --- a/man/fetchNASIS.Rd +++ b/man/fetchNASIS.Rd @@ -17,7 +17,7 @@ fetchNASIS( soilColorState = "moist", lab = FALSE, fill = FALSE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -44,10 +44,7 @@ site/pedon/horizon data (default: \code{FALSE})} \item{fill}{include pedon or component records without horizon data in result? (default: \code{FALSE})} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/fetchNASISWebReport.Rd b/man/fetchNASISWebReport.Rd index 3f3a1012..d277e00e 100644 --- a/man/fetchNASISWebReport.Rd +++ b/man/fetchNASISWebReport.Rd @@ -20,49 +20,43 @@ fetchNASISWebReport( projectname, rmHzErrors = FALSE, fill = FALSE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) -get_component_from_NASISWebReport( - projectname, - stringsAsFactors = default.stringsAsFactors() -) +get_component_from_NASISWebReport(projectname, stringsAsFactors = NULL) get_chorizon_from_NASISWebReport( projectname, fill = FALSE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) get_legend_from_NASISWebReport( mlraoffice, areasymbol, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) get_lmuaoverlap_from_NASISWebReport( areasymbol, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) get_mapunit_from_NASISWebReport( areasymbol, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) -get_projectmapunit_from_NASISWebReport( - projectname, - stringsAsFactors = default.stringsAsFactors() -) +get_projectmapunit_from_NASISWebReport(projectname, stringsAsFactors = NULL) get_projectmapunit2_from_NASISWebReport( mlrassoarea, fiscalyear, projectname, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) get_project_from_NASISWebReport(mlrassoarea, fiscalyear) @@ -84,11 +78,7 @@ results? (default: \code{FALSE})} \item{fill}{should rows with missing component ids be removed (default: \code{FALSE})} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded). The 'factory-fresh' default is TRUE, but this can be changed by -setting options(\code{stringsAsFactors = FALSE})} +\item{stringsAsFactors}{deprecated} \item{mlraoffice}{text string value identifying the MLRA Regional Soil Survey Office group name inserted into a SQL WHERE clause (default: \code{NA})} diff --git a/man/fetchSDA.Rd b/man/fetchSDA.Rd index acd939ad..b6b4be82 100644 --- a/man/fetchSDA.Rd +++ b/man/fetchSDA.Rd @@ -17,7 +17,7 @@ get_component_from_SDA( childs = TRUE, droplevels = TRUE, nullFragsAreZero = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) get_cointerp_from_SDA( @@ -25,26 +25,18 @@ get_cointerp_from_SDA( mrulename = NULL, duplicates = FALSE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) -get_legend_from_SDA( - WHERE = NULL, - droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() -) +get_legend_from_SDA(WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL) get_lmuaoverlap_from_SDA( WHERE = NULL, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) -get_mapunit_from_SDA( - WHERE = NULL, - droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() -) +get_mapunit_from_SDA(WHERE = NULL, droplevels = TRUE, stringsAsFactors = NULL) get_chorizon_from_SDA( WHERE = NULL, @@ -52,7 +44,7 @@ get_chorizon_from_SDA( childs = TRUE, nullFragsAreZero = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) fetchSDA( @@ -62,7 +54,7 @@ fetchSDA( nullFragsAreZero = TRUE, rmHzErrors = FALSE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors() + stringsAsFactors = NULL ) } \arguments{ @@ -81,11 +73,7 @@ classes, which can waste space in tables and figures.} \item{nullFragsAreZero}{should fragment volumes of NULL be interpreted as 0? (default: TRUE), see details} -\item{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 set outside of uncode() (i.e. hard coded). -The 'factory-fresh' default is TRUE, but this can be changed by setting -options(stringsAsFactors = FALSE)} +\item{stringsAsFactors}{deprecated} \item{mrulename}{character. Interpretation rule names} diff --git a/man/fetchVegdata.Rd b/man/fetchVegdata.Rd index 430e7726..af35c9d0 100644 --- a/man/fetchVegdata.Rd +++ b/man/fetchVegdata.Rd @@ -14,29 +14,17 @@ \alias{get_vegplot_trhi_from_NASIS_db} \title{Get vegetation plot data from local NASIS database} \usage{ -fetchVegdata( - SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), - dsn = NULL -) +fetchVegdata(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) -get_vegplot_from_NASIS_db( - SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), - dsn = NULL -) +get_vegplot_from_NASIS_db(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) get_vegplot_location_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) -get_vegplot_trhi_from_NASIS_db( - SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), - dsn = NULL -) +get_vegplot_trhi_from_NASIS_db(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) get_vegplot_species_from_NASIS_db( SS = TRUE, @@ -46,19 +34,19 @@ get_vegplot_species_from_NASIS_db( get_vegplot_transect_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) get_vegplot_transpecies_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) get_vegplot_tree_si_summary_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) @@ -71,17 +59,14 @@ get_vegplot_tree_si_details_from_NASIS_db( get_vegplot_textnote_from_NASIS_db( SS = TRUE, fixLineEndings = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } \arguments{ \item{SS}{fetch data from the currently loaded selected set in NASIS or from the entire local database (default: \code{TRUE})} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_comonth_from_NASIS_db.Rd b/man/get_comonth_from_NASIS_db.Rd index 9fb7e2ed..a1627a5e 100644 --- a/man/get_comonth_from_NASIS_db.Rd +++ b/man/get_comonth_from_NASIS_db.Rd @@ -7,7 +7,7 @@ get_comonth_from_NASIS_db( SS = TRUE, fill = FALSE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -18,11 +18,7 @@ the entire local database (default: TRUE)} \item{fill}{should missing "month" rows in the comonth table be filled with NA (FALSE)} -\item{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 set outside of uncode() (i.e. hard coded). -The 'factory-fresh' default is TRUE, but this can be changed by setting -options(stringsAsFactors = FALSE)} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_component_data_from_NASIS_db.Rd b/man/get_component_data_from_NASIS_db.Rd index f3058280..1cc66dcd 100644 --- a/man/get_component_data_from_NASIS_db.Rd +++ b/man/get_component_data_from_NASIS_db.Rd @@ -17,7 +17,7 @@ get_component_data_from_NASIS_db( SS = TRUE, nullFragsAreZero = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) @@ -29,7 +29,7 @@ get_component_correlation_data_from_NASIS_db( SS = TRUE, dropAdditional = TRUE, dropNotRepresentative = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) @@ -39,13 +39,13 @@ get_component_cogeomorph_data_from_NASIS_db2(SS = TRUE, dsn = NULL) get_component_copm_data_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) get_component_esd_data_from_NASIS_db( SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) @@ -66,11 +66,7 @@ the entire local database (default: \code{TRUE})} \item{nullFragsAreZero}{should surface fragment cover percentages of NULL be interpreted as 0? (default: TRUE)} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have set outside of \code{uncode()} (i.e. hard coded). -The 'factory-fresh' default is TRUE, but this can be changed by setting -options(\code{stringsAsFactors = FALSE})} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_cosoilmoist_from_NASIS.Rd b/man/get_cosoilmoist_from_NASIS.Rd index 56873079..b8a23d32 100644 --- a/man/get_cosoilmoist_from_NASIS.Rd +++ b/man/get_cosoilmoist_from_NASIS.Rd @@ -7,7 +7,7 @@ get_cosoilmoist_from_NASIS( SS = TRUE, impute = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -19,11 +19,7 @@ the entire local database (default: \code{TRUE})} categorical data, or the "RV" for numeric data or \code{201} cm if the "RV" is also \code{NULL} (default: \code{TRUE})} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have set outside of \code{uncode()} (i.e. hard coded). -The 'factory-fresh' default is TRUE, but this can be changed by setting -options(\code{stringsAsFactors = FALSE})} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_extended_data_from_NASIS_db.Rd b/man/get_extended_data_from_NASIS_db.Rd index c4dfc474..aed374c2 100644 --- a/man/get_extended_data_from_NASIS_db.Rd +++ b/man/get_extended_data_from_NASIS_db.Rd @@ -7,7 +7,7 @@ get_extended_data_from_NASIS_db( SS = TRUE, nullFragsAreZero = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -18,10 +18,7 @@ the entire local database (default: \code{TRUE})} \item{nullFragsAreZero}{should fragment volumes of NULL be interpreted as 0? (default: TRUE), see details} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_hz_data_from_NASIS_db.Rd b/man/get_hz_data_from_NASIS_db.Rd index e7d704bf..bef7555a 100644 --- a/man/get_hz_data_from_NASIS_db.Rd +++ b/man/get_hz_data_from_NASIS_db.Rd @@ -7,7 +7,7 @@ get_hz_data_from_NASIS_db( SS = TRUE, fill = FALSE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -16,10 +16,7 @@ get_hz_data_from_NASIS_db( \item{fill}{include pedons without horizon data in result? default: \code{FALSE}} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_mapunit_from_NASIS.Rd b/man/get_mapunit_from_NASIS.Rd index 7a127da5..4401f9be 100644 --- a/man/get_mapunit_from_NASIS.Rd +++ b/man/get_mapunit_from_NASIS.Rd @@ -11,39 +11,32 @@ get_mapunit_from_NASIS( SS = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) get_legend_from_NASIS( SS = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) get_lmuaoverlap_from_NASIS( SS = TRUE, droplevels = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) -get_projectmapunit_from_NASIS( - SS = TRUE, - stringsAsFactors = default.stringsAsFactors(), - dsn = NULL -) +get_projectmapunit_from_NASIS(SS = TRUE, stringsAsFactors = NULL, dsn = NULL) } \arguments{ \item{SS}{fetch data from the currently loaded selected set in NASIS or from the entire local database (default: \code{TRUE})} \item{droplevels}{Drop unused levels from \code{farmlndcl} and other factor levels from NASIS domains?} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_site_data_from_NASIS_db.Rd b/man/get_site_data_from_NASIS_db.Rd index 36d084f0..c498ea9d 100644 --- a/man/get_site_data_from_NASIS_db.Rd +++ b/man/get_site_data_from_NASIS_db.Rd @@ -7,7 +7,7 @@ get_site_data_from_NASIS_db( SS = TRUE, nullFragsAreZero = TRUE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -17,10 +17,7 @@ database (default: \code{TRUE})} \item{nullFragsAreZero}{should surface fragment cover percentages of NULL be interpreted as 0? (default: TRUE)} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have been set outside of \code{uncode()} (i.e. hard -coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/get_soilseries_from_NASIS.Rd b/man/get_soilseries_from_NASIS.Rd index 28010f00..da53aa23 100644 --- a/man/get_soilseries_from_NASIS.Rd +++ b/man/get_soilseries_from_NASIS.Rd @@ -6,15 +6,13 @@ \title{Get records from the Soil Classification (SC) database} \usage{ get_soilseries_from_NASIS( - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL, delimiter = " over " ) } \arguments{ -\item{stringsAsFactors}{logical: should character vectors be converted to -factors? This argument is passed to the \code{uncode()} function. It does not -convert those vectors that have set outside of \code{uncode()} (i.e. hard coded).} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/man/uncode.Rd b/man/uncode.Rd index 0a577a7d..69a3bae3 100644 --- a/man/uncode.Rd +++ b/man/uncode.Rd @@ -11,7 +11,7 @@ uncode( invert = FALSE, db = "NASIS", droplevels = FALSE, - stringsAsFactors = default.stringsAsFactors(), + stringsAsFactors = NULL, dsn = NULL ) } @@ -28,8 +28,7 @@ indicates whether or not to query metadata from local NASIS database classifying factors. This is useful when a class has large number of unused classes, which can waste space in tables and figures.} -\item{stringsAsFactors}{logical: should character vectors be converted to -factors?} +\item{stringsAsFactors}{deprecated} \item{dsn}{Optional: path to local SQLite database containing NASIS table structure; default: \code{NULL}} diff --git a/misc/ISSR800-WCS-demo.R b/misc/ISSR800-WCS-demo.R index 203d33d0..52a6eafa 100644 --- a/misc/ISSR800-WCS-demo.R +++ b/misc/ISSR800-WCS-demo.R @@ -18,7 +18,7 @@ z <- lapply(v$var, function(i) { names(z) <- v$var -which(sapply(z, function(i) class(i) == 'try-error')) +which(sapply(z, function(i) inherits(i, 'try-error')))