Merge pull request #395 from ncss-tech/lint1

Linting 1

Author: brownag

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: soilDB
 Type: Package
 Title: Soil Database Interface
-Version: 2.8.10
+Version: 2.8.11
 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut"), email = "dylan.beaudette@usda.gov"),
              person(given="Jay", family="Skovlin", role = c("aut")), 
              person(given="Stephen", family="Roecker", role = c("aut")), 

R/ISSR800.R

@@ -228,10 +228,9 @@ ISSR800.wcs <- function(aoi, var, res = 800, quiet = FALSE) {
   input_class <- attr(wcs.geom, '.input_class')
 
   if ((!is.null(input_class) && input_class == "raster") ||
-      getOption('soilDB.return_Spatial', default = FALSE)) {
-    if (requireNamespace("raster")) {
-      r <- raster::raster(r)
-    }
+      getOption('soilDB.return_Spatial', default = FALSE) && 
+      requireNamespace("raster")) {
+    r <- raster::raster(r)
   }
 
   # set metadata

R/KSSL_VG_model.R

@@ -1,21 +1,16 @@
-
 # define van Genuchten model as a function
 # this is tailored to the parameters stored in our KSSL data
 # https://en.wikipedia.org/wiki/Water_retention_curve
 .vg <- function(phi, theta_r, theta_s, alpha, n) {
   theta_r + ((theta_s - theta_r) / ((1 + (alpha * phi) ^ n) ^ (1 - 1 / n)))
 }
 
-
-
-
 ## notes: Rosetta units for alpha and npar are log10(1/cm) and log10([-])
 # VG_params: table of VG parameters from KSSL / Rosetta:  alpha and npar are in log10 form
 # phi_min: lower limit for water potential in kPa
 # phi_max: upper limit for water potential in kPa
 # pts: number of points to include in curve
 
-
 #' @title Develop a Water Retention Curve from KSSL Data
 #' 
 #' @description Water retention curve modeling via van Genuchten model and KSSL data.
@@ -56,8 +51,6 @@
 #' 
 # 'van Genuchten, M.Th. (1980). "A closed-form equation for predicting the hydraulic conductivity of unsaturated soils". Soil Science Society of America Journal. 44 (5): 892-898. 
 #' 
-#' 
-#' 
 #' @export
 #'
 #' @examples
@@ -77,8 +70,8 @@
 KSSL_VG_model <- function(VG_params, phi_min = 10^-6, phi_max = 10^8, pts = 100) {
 
   # sanity check, expected columns
-  if( any(! c('theta_r', 'theta_s', 'alpha', 'npar') %in% names(VG_params)) ) {
-    message('one or more required column is missing')
+  if (!all(c('theta_r', 'theta_s', 'alpha', 'npar') %in% names(VG_params))) {
+    message('one or more required columns is missing')
     return(list(VG_curve = NULL, VG_inverse_function = NULL))
   }
 
@@ -87,15 +80,14 @@ KSSL_VG_model <- function(VG_params, phi_min = 10^-6, phi_max = 10^8, pts = 100)
 
   # sanity check: no NA allowed
   # return NULL if present
-  if(any(is.na(VG_params))) {
+  if (anyNA(VG_params)) {
     message('one or more required value is NA')
     return(list(VG_curve = NULL, VG_inverse_function = NULL))
   }
 
-  
   # useful range in kPa suctions
-  phi <- 10^seq(log(phi_min, base=10), log(phi_max, base=10), length.out = pts)
-  m <- data.frame(phi=phi)
+  phi <- 10^seq(log(phi_min, base = 10), log(phi_max, base = 10), length.out = pts)
+  m <- data.frame(phi = phi)
 
   # Rosetta units for alpha and npar are 1/cm and [-]
   # convert kPa to cm of H20
@@ -121,8 +113,9 @@ KSSL_VG_model <- function(VG_params, phi_min = 10^-6, phi_max = 10^8, pts = 100)
   vg.inv <- splinefun(m$theta, m$phi)
 
   # return curve and spline function
-  return(list(VG_curve=m, VG_function=vg.fwd, VG_inverse_function=vg.inv))
+  return(list(
+    VG_curve = m,
+    VG_function = vg.fwd,
+    VG_inverse_function = vg.inv
+  ))
 }
-
-
-

R/OSDquery.R

@@ -83,7 +83,7 @@ OSDquery <- function(everything = NULL, mlra='', taxonomic_class='', typical_ped
     ## searching by sections
 
     # build parameters list
-    parameters=list(
+    parameters <- list(
       json = 1,
       mlra = mlra,
       taxonomic_class = taxonomic_class, 
@@ -105,7 +105,7 @@ OSDquery <- function(everything = NULL, mlra='', taxonomic_class='', typical_ped
     ## searching entire OSD text
 
     # build parameters list
-    parameters=list(
+    parameters <- list(
       json = 1,
       query = everything,
       mlra = mlra

R/ROSETTA.R

@@ -205,7 +205,7 @@ ROSETTA <- function(x, vars, v = c('1', '2', '3'), include.sd = FALSE, chunkSize
   }
 
   # chunk
-  x[['.chunk']] <- makeChunks(1:nrow(x), size = chunkSize)
+  x[['.chunk']] <- makeChunks(seq_len(nrow(x)), size = chunkSize)
 
   # split
   x <- split(x, x[['.chunk']])
@@ -233,7 +233,7 @@ ROSETTA <- function(x, vars, v = c('1', '2', '3'), include.sd = FALSE, chunkSize
 
   # stack into DF
   res <- do.call('rbind', res)
-  row.names(res) <- as.character(1:nrow(res))
+  row.names(res) <- as.character(seq_len(nrow(res)))
 
   # remove chunkID
   res[['.chunk']] <- NULL

R/SDA-spatial.R

@@ -259,7 +259,7 @@ SDA_spatialQuery <- function(geom,
                              query_string = FALSE,
                              as_Spatial = getOption('soilDB.return_Spatial', default = FALSE)) {
   if (byFeature) {
-    res <- do.call('rbind', lapply(1:nrow(geom), function(i) {
+    res <- do.call('rbind', lapply(seq_len(nrow(geom)), function(i) {
       res2 <- .SDA_spatialQuery(
         geom = geom[i, ],
         what = what,

R/SDA_query.R

@@ -35,7 +35,7 @@ format_SQL_in_statement <- function(x) {
   # and, plenty safe to perform a second time, in case this was done outside of the function call
   x <- unique(x)
 	i <- paste(x, collapse = "','")
-	i <- paste("('", i, "')", sep = '')
+	i <- paste0("('", i, "')")
 	return(i)
 }
 
@@ -167,22 +167,20 @@ SDA_query <- function(q, dsn = NULL) {
   # check response content type
   h <- r$all_headers
 
-  if (!is.null(h)) {
-    if (length(h) == 0 
+  if (!is.null(h) && (length(h) == 0 
         || is.null(h[[1]]$headers$`content-type`)
         || !h[[1]]$headers$`content-type` %in% 
                             c("application/json; charset=utf-8", # data response
                               "text/xml; charset=utf-8") # error response (maybe not anymore?)
-       ) {
-      msg <- "Soil Data Access REST API is not currently available, please try again later."
-      if (is.null(h[[1]]$headers$`content-type`)) {
-        txt <- try(httr::content(r, as = "text", encoding = "UTF-8"), silent = TRUE)
-        if (!inherits(txt, 'try-error')) {
-          msg <- gsub("<[^>]*>", "", txt)
-        }
+  )) {
+    msg <- "Soil Data Access REST API is not currently available, please try again later."
+    if (is.null(h[[1]]$headers$`content-type`)) {
+      txt <- try(httr::content(r, as = "text", encoding = "UTF-8"), silent = TRUE)
+      if (!inherits(txt, 'try-error')) {
+        msg <- gsub("<[^>]*>", "", txt)
       }
-      r <- try(stop(msg, call. = FALSE), silent = TRUE)
     }
+    r <- try(stop(msg, call. = FALSE), silent = TRUE)
   }
 
   if (inherits(r, 'try-error')) {
@@ -209,8 +207,7 @@ SDA_query <- function(q, dsn = NULL) {
       }
 
       ## inject specific message into a try-error result
-      request.status <- try(stop(paste0(attr(request.status, 'condition')$message, "\n",
-                                        error.msg), call. = FALSE), silent = TRUE)
+      request.status <- try(stop(attr(request.status, 'condition')$message, "\n", error.msg), silent = TRUE)
     }
 
     # return the error object so calling function/user can handle it
@@ -223,9 +220,9 @@ SDA_query <- function(q, dsn = NULL) {
   # note: the data returned by SDA/JSON are all character class
   #       we "fix" this later on
   r.content <- try(httr::content(r, as = 'text', encoding = 'UTF-8'), silent = TRUE)
-
-  if (inherits(r.content,'try-error'))
-      return(invisible(r.content))
+  
+  if (inherits(r.content, 'try-error'))
+    return(invisible(r.content))
 
   d <- try(jsonlite::fromJSON(r.content), silent = TRUE)
 
@@ -291,50 +288,36 @@ SDA_query <- function(q, dsn = NULL) {
     dt <- strsplit(j, split = ',', fixed = TRUE)[[1]][8]
     # known data types in SDA and appropriate classes in R
     # fall-back to "character" for unknown data types
-    switch(dt,
-           'DataTypeName=char' = 'character',
-           'DataTypeName=nchar' = 'character',
-           'DataTypeName=varchar' = 'character',
-           'DataTypeName=nvarchar' = 'character',
-           'DataTypeName=text' = 'character',
-           'DataTypeName=ntext' = 'character',
-           'DataTypeName=datetime' = 'character',
-           'DataTypeName=datetime2' = 'character',
-           'DataTypeName=timestamp' = 'character',
-           'DataTypeName=bit' = 'integer',
-           'DataTypeName=int' = 'integer',
-           'DataTypeName=bigint' = 'integer',
-           'DataTypeName=smallint' = 'integer',
-           'DataTypeName=tinyint' = 'integer',
-           'DataTypeName=numeric' = 'numeric',
-           'DataTypeName=real' = 'numeric',
-           'DataTypeName=float' = 'numeric',
-           'DataTypeName=decimal' = 'numeric',
-           'character'
-           )
+    switch(
+      dt,
+      'DataTypeName=char' = 'character',
+      'DataTypeName=nchar' = 'character',
+      'DataTypeName=varchar' = 'character',
+      'DataTypeName=nvarchar' = 'character',
+      'DataTypeName=text' = 'character',
+      'DataTypeName=ntext' = 'character',
+      'DataTypeName=datetime' = 'character',
+      'DataTypeName=datetime2' = 'character',
+      'DataTypeName=timestamp' = 'character',
+      'DataTypeName=bit' = 'integer',
+      'DataTypeName=int' = 'integer',
+      'DataTypeName=bigint' = 'integer',
+      'DataTypeName=smallint' = 'integer',
+      'DataTypeName=tinyint' = 'integer',
+      'DataTypeName=numeric' = 'numeric',
+      'DataTypeName=real' = 'numeric',
+      'DataTypeName=float' = 'numeric',
+      'DataTypeName=decimal' = 'numeric',
+      'character'
+    )
   })
 
   # convert each column that isn't character
   idx <- which(cc != 'character')
-  for(f in idx) {
+  for (f in idx) {
     df[, f] <- as(df[, f], cc[f])
   }
-
-
-  ## strings resembling scientific notation are converted into numeric
-  ## ex: type.convert("8E2") -> 800
-  # https://github.com/ncss-tech/soilDB/issues/190
-
-  # # attempt type conversion
-  # # same result as writing to file and reading-in via read.table()
-  # df <- type.convert(df,
-  #                    na.strings = c('', 'NA'),
-  #                    as.is = TRUE,
-  #                    colClasses = cc
-  #                    )
-
-  ## TODO further error checking?
-
+  
   return(df)
 }
 

R/SSURGO_spatial_query.R

@@ -53,16 +53,16 @@ SoilWeb_spatial_query <- function(bbox=NULL, coords=NULL, what='mapunit', source
 
   # process filter components
   if(!missing(coords)) {
-    f <- paste('&lon=', coords[1], '&lat=', coords[2], sep='')
+    f <- paste0('&lon=', coords[1], '&lat=', coords[2])
   }
 
   if(!missing(bbox)) {
     bbox <- paste(bbox, collapse=',')
-    f <- paste('&bbox=', bbox, sep='')
+    f <- paste0('&bbox=', bbox)
   }
 
   # build URL
-  the.url <- paste('https://casoilresource.lawr.ucdavis.edu/soil_web/api/ssurgo.php?what=mapunit', f, sep='')
+  the.url <- paste0('https://casoilresource.lawr.ucdavis.edu/soil_web/api/ssurgo.php?what=mapunit', f)
 
   # attempt to load data from URL/JSON
   # note: this may fail when done over gov VPN