From 19c15de3d32a7fe135dded18f653ab303b297686 Mon Sep 17 00:00:00 2001 From: Andrew Brown Date: Thu, 24 Feb 2022 14:32:44 -0800 Subject: [PATCH] Deprecate `stringsAsFactors` argument to `uncode()` #130 - default.stringsAsFactors() has been deprecated; --- R/fetchHenry.R | 3 - R/fetchNASIS.R | 17 ++-- R/fetchNASISWebReport.R | 107 ++++++++++++++++-------- R/fetchNASIS_components.R | 15 ++-- R/fetchNASIS_pedons.R | 17 ++-- R/fetchNASIS_report.R | 33 +++++--- R/fetchOSD.R | 2 +- R/fetchVegdata.R | 33 ++++---- R/get_colors_from_NASIS_db.R | 2 +- R/get_component_data_from_NASIS_db.R | 59 ++++++++----- R/get_component_from_GDB.R | 32 +++---- R/get_component_from_SDA.R | 81 ++++++++++-------- R/get_concentrations_from_NASIS_db.R | 11 ++- R/get_cosoilmoist_from_LIMS.R | 9 +- R/get_cosoilmoist_from_NASIS.R | 19 +++-- R/get_cosoilmoist_from_SDA.R | 10 ++- R/get_extended_data_from_NASIS_db.R | 35 ++++---- R/get_hz_data_from_NASIS_db.R | 17 ++-- R/get_mapunit_from_NASIS.R | 23 ++--- R/get_phfmp_from_NASIS_db.R | 10 ++- R/get_projectmapunit_from_NASIS.R | 9 +- R/get_site_data_from_NASIS_db.R | 25 ++---- R/get_soilseries_from_NASIS.R | 28 ++++--- R/get_vegplot_data_from_NASIS_db.R | 75 ++++++++++++----- R/uncode.R | 20 +++-- R/utils.R | 2 +- man/fetchGDB.Rd | 8 +- man/fetchNASIS.Rd | 7 +- man/fetchNASISWebReport.Rd | 28 ++----- man/fetchSDA.Rd | 28 ++----- man/fetchVegdata.Rd | 33 ++------ man/get_comonth_from_NASIS_db.Rd | 8 +- man/get_component_data_from_NASIS_db.Rd | 14 ++-- man/get_cosoilmoist_from_NASIS.Rd | 8 +- man/get_extended_data_from_NASIS_db.Rd | 7 +- man/get_hz_data_from_NASIS_db.Rd | 7 +- man/get_mapunit_from_NASIS.Rd | 17 ++-- man/get_site_data_from_NASIS_db.Rd | 7 +- man/get_soilseries_from_NASIS.Rd | 6 +- man/uncode.Rd | 5 +- misc/ISSR800-WCS-demo.R | 2 +- 41 files changed, 468 insertions(+), 411 deletions(-) diff --git a/R/fetchHenry.R b/R/fetchHenry.R index 8e7b05da..4151eab5 100644 --- a/R/fetchHenry.R +++ b/R/fetchHenry.R @@ -287,9 +287,6 @@ 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 - opt.original <- options(stringsAsFactors = FALSE) - # sanity-check: `what` should be within the legal set of options if(! what %in% c('all', 'sensors', 'soiltemp', 'soilVWC', 'airtemp', 'waterlevel')) stop("`what` must be either: 'all', 'sensors', 'soiltemp', 'soilVWC', 'airtemp', or 'waterlevel'", call.=FALSE) diff --git a/R/fetchNASIS.R b/R/fetchNASIS.R index a4ed0636..9cb5dcb8 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..ee342714 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + url <- "https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=get_chorizon_from_NASISWebReport" d.chorizon <- lapply(projectname, function(x) { @@ -147,12 +157,12 @@ 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) { - texcl = factor(texcl, - levels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceValue"], - labels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"] - ) - } + # if (stringsAsFactors == TRUE) { + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..3f8bd04e 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..c8619f6e 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..56342a0a 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..0b0d9d84 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..d8d98ae9 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } 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..ed5d6380 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } 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) { - texcl = factor(tolower(texcl), levels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"]) - } - if (droplevels == droplevels & is.factor(texcl)) { - texcl = droplevels(texcl) - } + # if (stringsAsFactors == TRUE) { + # texcl = factor(tolower(texcl), levels = metadata[metadata$ColumnPhysicalName == "texcl", "ChoiceName"]) + # } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..37d10c7d 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..4f383f07 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } # 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..fe62bc5a 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..d283903b 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..ca01e45e 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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) + 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..e3d12712 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..cb45126e 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } 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..9bd690ba 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..fc02bc68 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..7f2eca7c 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..04b6e116 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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..2e9b5b02 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # 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..ea971181 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)) { + .Deprecated(msg = "stringsAsFactors argument is deprecated") + stringsAsFactors <- FALSE + } + # load current metadata table if (db == "NASIS") { metadata <- .get_NASIS_metadata(dsn = dsn) @@ -131,11 +135,9 @@ uncode <- function(df, } # convert factors to strings - if (stringsAsFactors == FALSE) { - idx <- unlist(lapply(df, is.factor)) - df[idx] <- lapply(df[idx], as.character) - } - + idx <- unlist(lapply(df, is.factor)) + df[idx] <- lapply(df[idx], as.character) + return(df) } 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/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')))