Merge pull request #121 from ncss-tech/fetchNASISReports

demoting fetchNASIS_pedons() and fetchNASIS_components() to internal functions
ncss-tech · Jan 22, 2020 · e80177d · e80177d
2 parents d80a5fb + 447013e
commit e80177d
Show file tree

Hide file tree

Showing 11 changed files with 63 additions and 48 deletions.
diff --git a/R/fetchNASIS.R b/R/fetchNASIS.R
@@ -1,7 +1,16 @@
 # convenient interface to local NASIS data
 # from: pedons | components | lab | ???
 # ... : arguments passed on to helper functions
-fetchNASIS <- function(from='pedons', url = NULL, ...) {
+fetchNASIS <- function(from='pedons', 
+                       url = NULL, 
+                       SS = TRUE, 
+                       rmHzErrors = TRUE,
+                       nullFragsAreZero = TRUE, 
+                       soilColorState = 'moist', 
+                       lab = FALSE, 
+                       fill = FALSE,
+                       stringsAsFactors = default.stringsAsFactors()
+                       ) {
 
   res <- NULL
 
@@ -12,17 +21,32 @@ fetchNASIS <- function(from='pedons', url = NULL, ...) {
 
   if(from == 'pedons') {
     # pass arguments through
-    res <- fetchNASIS_pedons(...)
+    res <- .fetchNASIS_pedons(SS = SS, 
+                              rmHzErrors = rmHzErrors,
+                              nullFragsAreZero = nullFragsAreZero, 
+                              soilColorState = soilColorState, 
+                              lab = lab,
+                              stringsAsFactors = stringsAsFactors
+                              )
   }
 
   if(from == 'components') {
     # pass arguments through
-    res <- fetchNASIS_components(...)
+    res <- .fetchNASIS_components(SS = TRUE,
+                                  rmHzErrors = rmHzErrors, 
+                                  fill = fill, 
+                                  stringsAsFactors = stringsAsFactors
+                                  )
   }
 
   if(from == 'pedon_report') {
     # pass arguments through
-    res <- .fetchNASIS_report(url = url, ...)
+    res <- .fetchNASIS_report(url              = url,
+                              rmHzErrors       = rmHzErrors,
+                              nullFragsAreZero = nullFragsAreZero, 
+                              soilColorState   = soilColorState, 
+                              stringsAsFactors = stringsAsFactors
+                              )
   }
 
   return(res)

diff --git a/R/fetchNASIS_components.R b/R/fetchNASIS_components.R
@@ -2,7 +2,7 @@
 # https://github.com/ncss-tech/soilDB/issues/50
 ## TODO: this will not ID horizons with no depths
 ## TODO: better error checking / reporting is needed: coiid, dmu id, component name
-fetchNASIS_components <- function(SS=TRUE, rmHzErrors=TRUE, fill = FALSE, stringsAsFactors = default.stringsAsFactors()) {
+.fetchNASIS_components <- function(SS=TRUE, rmHzErrors=TRUE, fill = FALSE, stringsAsFactors = default.stringsAsFactors()) {
   # must have RODBC installed
   if(!requireNamespace('RODBC'))
     stop('please install the `RODBC` package', call.=FALSE)

diff --git a/R/fetchNASIS_pedons.R b/R/fetchNASIS_pedons.R
@@ -1,7 +1,7 @@
 
 
 # get NASIS site/pedon/horizon/diagnostic feature data
-fetchNASIS_pedons <- function(SS=TRUE, rmHzErrors=TRUE, nullFragsAreZero=TRUE, soilColorState='moist', lab=FALSE, stringsAsFactors = default.stringsAsFactors()) {
+.fetchNASIS_pedons <- function(SS=TRUE, rmHzErrors=TRUE, nullFragsAreZero=TRUE, soilColorState='moist', lab=FALSE, stringsAsFactors = default.stringsAsFactors()) {
 
   # test connection
   if(! 'nasis_local' %in% names(RODBC::odbcDataSources()))

diff --git a/R/fetchNASIS_report.R b/R/fetchNASIS_report.R
@@ -1,10 +1,10 @@
 
 .fetchNASIS_report <- function(url = NULL,
-                                rmHzErrors       = TRUE,
-                                nullFragsAreZero = TRUE, 
-                                soilColorState   = "moist", 
-                                stringsAsFactors = default.stringsAsFactors()
-                                ) {
+                               rmHzErrors       = TRUE,
+                               nullFragsAreZero = TRUE, 
+                               soilColorState   = "moist", 
+                               stringsAsFactors = default.stringsAsFactors()
+                               ) {
 
   tf = "C:/ProgramData/USDA/NASIS/Temp/fetchNASIS.txt"
   if (!is.null(url)) tf = url

diff --git a/R/get_component_from_SDA.R b/R/get_component_from_SDA.R
@@ -500,18 +500,18 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE,
 }
 
 
-get_diagnostics_from_SDA <- function(target_cokeys) {
+.get_diagnostics_from_SDA <- function(target_cokeys) {
   # query SDA to get corresponding codiagfeatures
   q <- paste0('SELECT * FROM codiagfeatures WHERE cokey IN ', format_SQL_in_statement(target_cokeys), ";")
   return(SDA_query(q))
 }
 
-fetchSDA_component <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, 
-                               nullFragsAreZero = TRUE, 
-                               rmHzErrors = FALSE,
-                               drop.unused.levels = TRUE,
-                               stringsAsFactors = default.stringsAsFactors()
-                               ) {
+fetchSDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, 
+                     nullFragsAreZero = TRUE, 
+                     rmHzErrors = FALSE,
+                     drop.unused.levels = TRUE,
+                     stringsAsFactors = default.stringsAsFactors()
+                     ) {
 
   # load data in pieces
   f.component <- get_component_from_SDA(WHERE, 
@@ -529,7 +529,7 @@ fetchSDA_component <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE,
                                        )
 
   # diagnostic features  
-  f.diag <- get_diagnostics_from_SDA(f.component$cokey)
+  f.diag <- .get_diagnostics_from_SDA(f.component$cokey)
 
   # optionally test for bad horizonation... flag, and remove
   if (rmHzErrors) {

diff --git a/man/fetchNASIS.Rd b/man/fetchNASIS.Rd
@@ -1,9 +1,7 @@
 \name{fetchNASIS}
 \alias{fetchNASIS}
 \alias{getHzErrorsNASIS}
-\alias{fetchNASIS_pedons}
 \alias{get_phorizon_from_NASIS_db}
-\alias{fetchNASIS_components}
 \alias{get_component_copm_data_from_NASIS_db}
 \alias{get_component_horizon_data_from_NASIS_db}
 \alias{get_component_correlation_data_from_NASIS_db}
@@ -17,7 +15,6 @@
 \alias{get_lmuaoverlap_from_NASIS}
 \alias{get_mapunit_from_NASIS}
 \alias{get_projectmapunit_from_NASIS}
-\alias{get_projectstaff_from_NASIS}
 \alias{get_component_diaghz_from_NASIS_db}
 \alias{get_mutext_from_NASIS_db}
 
@@ -38,22 +35,17 @@
 \description{Fetch commonly used site/pedon/horizon data or component from NASIS, returned as a SoilProfileCollection object.}
 
 \usage{
-fetchNASIS(from = 'pedons', url = NULL, ...)
-
-fetchNASIS_pedons(SS=TRUE, rmHzErrors=TRUE, nullFragsAreZero=TRUE, 
-                  soilColorState='moist', lab=FALSE, 
+fetchNASIS(from = 'pedons', url = NULL, SS=TRUE, rmHzErrors=TRUE, nullFragsAreZero=TRUE, 
+                  soilColorState='moist', lab=FALSE, fill = FALSE,
                   stringsAsFactors = default.stringsAsFactors()
                   )
-fetchNASIS_components(SS=TRUE, rmHzErrors=TRUE, fill = FALSE, 
-                      stringsAsFactors = default.stringsAsFactors()
-                      )
+
 getHzErrorsNASIS(strict=TRUE)
 }
 
 \arguments{
   \item{from}{determines what objects should fetched? ('pedons' | 'components' | 'pedon_report')}
   \item{url}{string specifying the url for the NASIS pedon_report (default: NULL)}
-  \item{\dots}{arguments passed to \code{fetchNASIS_pedons()} or \code{fetchNASIS_components()}}
   \item{SS}{fetch data from the currently loaded selected set in NASIS or from the entire local database (default: TRUE)}
   \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 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)}
   \item{rmHzErrors}{should pedons with horizonation errors be removed from the results? (default: TRUE)}

diff --git a/man/fetchSDA_component.Rd b/man/fetchSDA_component.Rd
@@ -1,5 +1,5 @@
-\name{fetchSDA_component}
-\alias{fetchSDA_component}
+\name{fetchSDA}
+\alias{fetchSDA}
 \alias{get_legend_from_SDA}
 \alias{get_lmuaoverlap_from_SDA}
 \alias{get_mapunit_from_SDA}
@@ -8,16 +8,15 @@
 \alias{get_cosoilmoist_from_SDA}
 \alias{get_cosoilmoist_from_NASIS}
 \alias{get_cointerp_from_SDA}
-\alias{get_diagnostics_from_SDA}
 
 \title{Extract component tables from Soil Data Access}
 \description{Get, format, impute, and return component tables.}
 \usage{
-fetchSDA_component(WHERE = NULL, duplicates = FALSE, childs = TRUE, 
-                   nullFragsAreZero = TRUE, rmHzErrors = FALSE,
-                   drop.unused.levels = TRUE,
-                   stringsAsFactors = default.stringsAsFactors()
-                   )
+fetchSDA(WHERE = NULL, duplicates = FALSE, childs = TRUE, 
+         nullFragsAreZero = TRUE, rmHzErrors = FALSE,
+         drop.unused.levels = TRUE,
+         stringsAsFactors = default.stringsAsFactors()
+         )
 
 get_mapunit_from_SDA(WHERE = NULL, 
                      drop.unused.levels = TRUE,
@@ -62,7 +61,7 @@ If the duplicates argument is set to TRUE, duplicate components are returned. Th
 
 The function get_cosoilmoist_from_NASIS_db() only works only on Windows , and requires a 'nasis_local' ODBC connection. See the \href{http://ncss-tech.github.io/AQP/soilDB/setup_local_nasis.html}{NASIS ODBC Setup tutorial} for instructions. 
 
-The value of \code{nullFragsAreZero} will have a significant impact on the rock fragment fractions returned by \code{fetchSDA_component}. Set \code{nullFragsAreZero = FALSE} in those cases where there are many data-gaps and NULL rock fragment values should be interpretated as NULLs. Set \code{nullFragsAreZero = TRUE} in those cases where NULL rock fragment values should be interpreted as 0.
+The value of \code{nullFragsAreZero} will have a significant impact on the rock fragment fractions returned by \code{fetchSDA}. Set \code{nullFragsAreZero = FALSE} in those cases where there are many data-gaps and NULL rock fragment values should be interpretated as NULLs. Set \code{nullFragsAreZero = TRUE} in those cases where NULL rock fragment values should be interpreted as 0.
 }
 \value{A dataframe or list with the results.}
 \author{Stephen Roecker}
@@ -82,7 +81,7 @@ if (
   requireNamespace("viridis", quietly = TRUE)
 ) {
   # query soil components by areasymbol and musym
-  test = fetchSDA_component(WHERE = "areasymbol = 'IN005' AND musym = 'MnpB2'")
+  test = fetchSDA(WHERE = "areasymbol = 'IN005' AND musym = 'MnpB2'")
 
   # profile plot
   plot(test)

diff --git a/man/get_comonth_from_NASIS_db.Rd b/man/get_comonth_from_NASIS_db.Rd
@@ -23,7 +23,7 @@ get_comonth_from_NASIS_db(SS = TRUE, fill = FALSE,
 
 
 \seealso{
-\code{\link{fetchNASIS}}, \code{\link{fetchNASIS_components}}
+\code{\link{fetchNASIS}}
 }
 
 \examples{

diff --git a/man/get_component_data_from_NASIS_db.Rd b/man/get_component_data_from_NASIS_db.Rd
@@ -23,7 +23,7 @@ get_component_restrictions_from_NASIS_db(SS = TRUE)
 %% ~Make other sections like Warning with \section{Warning }{....} ~
 
 \seealso{
-\code{\link{fetchNASIS}}, \code{\link{fetchNASIS_components}}
+\code{\link{fetchNASIS}}
 }
 
 \examples{

diff --git a/man/uncode.Rd b/man/uncode.Rd
@@ -30,7 +30,7 @@ code(df, ...)
 \examples{
 \donttest{
 # query component by nationalmusym
-comp = fetchSDA_component(WHERE = "nationalmusym = '2vzcp'")
+comp = fetchSDA(WHERE = "nationalmusym = '2vzcp'")
 s = site(comp$spc)
 s = uncode(s, NASIS = FALSE)
 levels(s$taxorder)

diff --git a/tests/testthat/test-fetchSDA_component.R b/tests/testthat/test-fetchSDA_component.R
@@ -1,22 +1,22 @@
-context("fetchSDA_component() -- requires internet connection")
+context("fetchSDA() -- requires internet connection")
 
 ## sample data: these should run in < 3 seconds
 
 
-test_that("fetchSDA_component() works", {
+test_that("fetchSDA() works", {
 
   skip_if_offline()
 
   # single component
-  x <<- suppressMessages(fetchSDA_component(WHERE="nationalmusym = 'kzc4'"))
+  x <<- suppressMessages(fetchSDA(WHERE="nationalmusym = 'kzc4'"))
 
   # basic test
   expect_true(inherits(x, 'SoilProfileCollection'))
 })
 
 ## tests
 
-test_that("fetchSDA_component() returns an SPC", {
+test_that("fetchSDA() returns an SPC", {
 
   skip_if_offline()
 
@@ -26,7 +26,7 @@ test_that("fetchSDA_component() returns an SPC", {
 
 })
 
-test_that("fetchSDA_component() returns expected results", {
+test_that("fetchSDA() returns expected results", {
 
   skip_if_offline()