Linting with lintr v3.1.1

- [scalar_in_linter] Use == to match length-1 scalars, not %in%. Note that == preserves NA where %in% does not. - [if_not_else_linter] In a simple if/else statement, prefer `if (A) x else y` to the less-readable `if (!A) y else x`. - [keyword_quote_linter] Only quote named arguments to functions if necessary, i.e., if the name is not a valid R symbol (see ?make.names) - [unreachable_code_linter] Code inside a conditional loop with a deterministically false condition should be removed
DrylandEcology · Dec 4, 2023 · 5e57a8b · 5e57a8b
1 parent 72d4bf2
commit 5e57a8b
Show file tree

Hide file tree

Showing 15 changed files with 74 additions and 99 deletions.
diff --git a/R/A_swGenericMethods.R b/R/A_swGenericMethods.R
@@ -137,7 +137,7 @@ check_version <- function(
       expected[[c(1, 3)]] <- 0
     }
 
-    if (level %in% "major") {
+    if (identical(level, "major")) {
       # zero the minor-level
       has[[c(1, 2)]] <- 0
       expected[[c(1, 2)]] <- 0

diff --git a/R/B_swFiles.R b/R/B_swFiles.R
@@ -143,7 +143,7 @@ setMethod(
     # Maintenance:
     #   update `do_upgrade` when `n_exp` changes or new upgrades required!
     do_upgrade <- c(
-      from_v230 = n_has == 22L && n_exp %in% 23L
+      from_v230 = n_has == 22L && n_exp == 23L
     )
 
     do_upgrade <- do_upgrade[do_upgrade]

diff --git a/R/D_swCloud.R b/R/D_swCloud.R
@@ -145,12 +145,12 @@ swCloud <- function(...) {
   # We don't set values for slot `Cloud` (except SnowDensity and RainEvents)
   # if not passed via ...; this is to prevent simulation runs with
   # accidentally incorrect values
-  if (!("Cloud" %in% dns)) {
-    ids <- 4:5
-    def@Cloud[- ids, ] <- NA_real_
-  } else {
+  if ("Cloud" %in% dns) {
     # Guarantee names
     dimnames(dots[["Cloud"]]) <- dimnames(def@Cloud)
+  } else {
+    ids <- 4:5
+    def@Cloud[- ids, ] <- NA_real_
   }
 
   tmp <- lapply(

diff --git a/R/D_swWeather.R b/R/D_swWeather.R
@@ -133,12 +133,12 @@ sw_upgrade_MonthlyScalingParams <- function( # nolint: object_length_linter.
   vars_exp <- colnames(default@MonthlyScalingParams)
   vars_has <- colnames(MonthlyScalingParams)
 
-  if (!all(vars_exp %in% vars_has)) {
+  if (all(vars_exp %in% vars_has)) {
+    MonthlyScalingParams
+  } else {
     res <- default@MonthlyScalingParams
     res[, vars_has] <- MonthlyScalingParams[, vars_has]
     res
-  } else {
-    MonthlyScalingParams
   }
 }
 
@@ -243,7 +243,7 @@ setValidity(
     sns <- setdiff(slotNames("swWeather"), inheritedSlotNames("swWeather"))
 
     for (sn in sns) {
-      n_exp <- if (sn %in% "dailyInputFlags") {
+      n_exp <- if (identical(sn, "dailyInputFlags")) {
         rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
       } else {
         1L

diff --git a/R/D_swWeatherData.R b/R/D_swWeatherData.R
@@ -44,20 +44,20 @@ weather_dataColumns <- function() {
 #' @export
 weather_dataAggFun <- function() {
   c(
-    "Tmax_C" = mean,
-    "Tmin_C" = mean,
-    "PPT_cm" = sum,
-    "cloudCov_pct" = mean,
-    "windSpeed_mPERs" = mean,
-    "windSpeed_east_mPERs" = mean,
-    "windSpeed_north_mPERs" = mean,
-    "rHavg_pct" = mean,
-    "rHmax_pct" = mean,
-    "rHmin_pct" = mean,
-    "specHavg_pct" = mean,
-    "Tdewpoint_C" = mean,
-    "actVP_kPa" = mean,
-    "shortWR" = mean
+    Tmax_C = mean,
+    Tmin_C = mean,
+    PPT_cm = sum,
+    cloudCov_pct = mean,
+    windSpeed_mPERs = mean,
+    windSpeed_east_mPERs = mean,
+    windSpeed_north_mPERs = mean,
+    rHavg_pct = mean,
+    rHmax_pct = mean,
+    rHmin_pct = mean,
+    specHavg_pct = mean,
+    Tdewpoint_C = mean,
+    actVP_kPa = mean,
+    shortWR = mean
   )
 }
 

diff --git a/R/F_swSite.R b/R/F_swSite.R
@@ -211,14 +211,14 @@ swSite <- function(...) {
     tmp <- c("Longitude", "Latitude", "Altitude", "Slope", "Aspect")
     def@IntrinsicSiteParams[tmp] <- NA_real_
   }
-  if (!("TranspirationRegions" %in% dns)) {
-    def@TranspirationRegions[, "layer"] <- NA_integer_
-  } else {
+  if ("TranspirationRegions" %in% dns) {
     # Guarantee names
     dimnames(dots[["TranspirationRegions"]]) <- list(
       NULL,
       colnames(def@TranspirationRegions)
     )
+  } else {
+    def@TranspirationRegions[, "layer"] <- NA_integer_
   }
 
   if ("swrc_flags" %in% dns) {

diff --git a/R/F_swSoils.R b/R/F_swSoils.R
@@ -185,24 +185,24 @@ swSoils <- function(...) {
 
   # We don't set values for slot `Layers` if not passed via ...; this
   # is to prevent simulation runs with accidentally incorrect values
-  if (!("Layers" %in% dns)) {
-    def@Layers <- def@Layers[1, , drop = FALSE]
-    def@Layers[] <- NA_real_
-    ntmp <- 1
-  } else {
+  if ("Layers" %in% dns) {
     # Guarantee names
     dimnames(dots[["Layers"]]) <- list(NULL, colnames(def@Layers))
     ntmp <- nrow(dots[["Layers"]])
+  } else {
+    def@Layers <- def@Layers[1, , drop = FALSE]
+    def@Layers[] <- NA_real_
+    ntmp <- 1
   }
 
   # We don't set values for slot `SWRCp` if not passed via ...; this
   # is to prevent simulation runs with accidentally incorrect values
-  if (!("SWRCp" %in% dns)) {
-    def@SWRCp <- def@SWRCp[rep.int(1, ntmp), , drop = FALSE]
-    def@SWRCp[] <- NA_real_
-  } else {
+  if ("SWRCp" %in% dns) {
     # Guarantee names
     dimnames(dots[["SWRCp"]]) <- list(NULL, colnames(def@SWRCp))
+  } else {
+    def@SWRCp <- def@SWRCp[rep.int(1, ntmp), , drop = FALSE]
+    def@SWRCp[] <- NA_real_
   }
 
   # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence

diff --git a/R/G_swOut.R b/R/G_swOut.R
@@ -281,7 +281,7 @@ setMethod(
     #   update `do_upgrade` when `n_exp` changes or new upgrades required!
     do_upgrade <- c(
       from_v230 = n_has == 30L && n_exp %in% 31L:32L,
-      from_v310 = n_has == 31L && n_exp %in% 32L
+      from_v310 = n_has == 31L && n_exp == 32L
     )
 
     do_upgrade <- do_upgrade[do_upgrade]

diff --git a/R/Rsw.R b/R/Rsw.R
@@ -502,15 +502,8 @@ set_requested_flags <- function(swIn, tag, use, values, fun, reset = TRUE,
       # Check dimensional agreement
       ndim_gt1_vals <- sum(dim(data.frame(vals)) > 1)
       ndim_gt1_def <- sum(dim(data.frame(def)) > 1)
-      if (!(ndim_gt1_vals == 1 && ndim_gt1_def == 1)) {
-        stop(
-          "ERROR: ",
-          toString(shQuote(val_names)),
-          " are not represented as 1-dimensional objects in",
-          " class 'swInputData'."
-        )
 
-      } else {
+      if (ndim_gt1_vals == 1 && ndim_gt1_def == 1) {
         # Transfer values
         itemp <- sapply(names(def), function(x) {
           k <- grep(substr(x, 1, 4), val_names)
@@ -522,6 +515,14 @@ set_requested_flags <- function(swIn, tag, use, values, fun, reset = TRUE,
         }
 
         swIn <- get(paste0(fun, "<-"))(swIn, def)
+
+      } else {
+        stop(
+          "ERROR: ",
+          toString(shQuote(val_names)),
+          " are not represented as 1-dimensional objects in",
+          " class 'swInputData'."
+        )
       }
     }
   }

diff --git a/R/swWeatherGenerator.R b/R/swWeatherGenerator.R
@@ -1705,10 +1705,7 @@ dbW_fixWeather <- function(
   dif_wd3 <- rSOILWAT2::calc_dailyInputFlags(weatherData3)
   vars_wd3 <- names(dif_wd3)[dif_wd3]
 
-  if (!any(is_missing_weather(weatherData3[, vars_wd3]))) {
-    weatherData4 <- weatherData3
-
-  } else {
+  if (any(is_missing_weather(weatherData3[, vars_wd3]))) {
     daymeans <- data.frame(
       Year = NA,
       aggregate(
@@ -1773,6 +1770,9 @@ dbW_fixWeather <- function(
 
     is_miss4 <- is_missing_weather(weatherData4[, weather_dataColumns()])
     meta[!is_miss4 & is_miss3] <- "longTermDailyMean"
+
+  } else {
+    weatherData4 <- weatherData3
   }
 
 

diff --git a/R/sw_Pedotransfer_Functions.R b/R/sw_Pedotransfer_Functions.R
@@ -769,7 +769,7 @@ rSW2_SWRC_PTF_estimate_parameters <- function( # nolint: object_length_linter.
   fail = TRUE,
   ...
 ) {
-  ptf_name <- std_ptf(ptf_name)[1]
+  ptf_name <- std_ptf(ptf_name)[[1L]]
   has_ptf <- ptf_name %in% ptfs_implemented_by_rSW2()
 
   list_soilargs <- list(
@@ -778,7 +778,7 @@ rSW2_SWRC_PTF_estimate_parameters <- function( # nolint: object_length_linter.
     bdensity = bdensity
   )
 
-  if (has_ptf && ptf_name %in% "Rosetta3") {
+  if (has_ptf && ptf_name == "Rosetta3") {
     dots <- list(...)
     dots[["version"]] <- if ("version" %in% names(dots)) {
       as.character(dots[["version"]])
@@ -791,7 +791,7 @@ rSW2_SWRC_PTF_estimate_parameters <- function( # nolint: object_length_linter.
       args = c(list_soilargs, dots)
     )
 
-  } else if (has_ptf && ptf_name %in% "neuroFX2021") {
+  } else if (has_ptf && ptf_name == "neuroFX2021") {
     do.call(
       ptf_neuroFX2021_for_FXW,
       args = c(list_soilargs, list(...))

diff --git a/tests/testthat/test_exec_and_aggregate.R b/tests/testthat/test_exec_and_aggregate.R
@@ -164,11 +164,14 @@ for (it in tests) {
 
   #------ Run SOILWAT2
   test_that("Simulate and aggregate", {
-    rd <- sw_exec(
-      inputData = sw_input,
-      weatherList = sw_weather,
-      echo = FALSE,
-      quiet = TRUE
+    # Run silently
+    expect_silent(
+      rd <- sw_exec(
+        inputData = sw_input,
+        weatherList = sw_weather,
+        echo = FALSE,
+        quiet = TRUE
+      )
     )
 
     # Check rSOILWAT2 output object
@@ -177,23 +180,6 @@ for (it in tests) {
     expect_false(has_soilTemp_failed())
     expect_true(all(sw_out_flags() %in% slotNames(rd)))
 
-    # Run silently/verbosely
-    expect_silent(sw_exec(
-      inputData = sw_input,
-      weatherList = sw_weather,
-      echo = FALSE, quiet = TRUE
-    ))
-
-    # This doesn't work; apparently, testthat::expect_message and similar
-    # functions don't capture text written by LogError directly to the console.
-    if (FALSE) {
-      expect_message(sw_exec(
-        inputData = sw_input,
-        weatherList = sw_weather,
-        echo = FALSE, quiet = FALSE
-      ))
-    }
-
 
     # Check that input weather is identical to output weather
     # (don't check missing days that the weather generator filled in)

diff --git a/tests/testthat/test_iOUT_macros.R b/tests/testthat/test_iOUT_macros.R
@@ -58,10 +58,6 @@ test_that("Tests of iOUT and iOUT2", {
           for (i in seq_len(n_vars)) {
             # test `iOUT` for 'key = 1'
             icol <- ncol_TimeOUT[pd] + i
-            if (FALSE) {
-              print(paste("key =", key, "var =", i, "irow =", irow_OUT[pd],
-                "icol =", icol, "iOUT =", iOUT(i, pd, irow_OUT)))
-            }
             p_OUT[key, pd][[1]][irow_OUT[pd], icol] <- iOUT(i, pd, irow_OUT)
           }
 
@@ -70,11 +66,6 @@ test_that("Tests of iOUT and iOUT2", {
           for (k in seq_len(NVEGTYPES)) {
             for (i in seq_len(n_layers)) {
               icol <- ncol_TimeOUT[pd] + i + n_layers * (k - 1)
-              if (FALSE) {
-                print(paste("key =", key, "veg =", k, "slyr =", i, "irow =",
-                  irow_OUT[pd], "icol =", icol, "iOUT =",
-                  iOUT2(i, k, pd, irow_OUT)))
-              }
               p_OUT[key, pd][[1]][irow_OUT[pd], icol] <-
                 iOUT2(i, k, pd, irow_OUT)
             }

diff --git a/tests/testthat/test_pedotransferfunctions.R b/tests/testthat/test_pedotransferfunctions.R
@@ -52,7 +52,10 @@ vwc_fix <- data.frame(
 row.names(vwc_fix) <- row.names(texture)
 
 ftemp <- file.path("..", "test_data", "swp_values.rds")
-if (FALSE) {
+if (file.exists(ftemp)) {
+  swp_vals <- readRDS(ftemp)
+
+} else {
   swp_vals <- unlist(lapply(
     row.names(texture),
     function(itext) {
@@ -70,9 +73,6 @@ if (FALSE) {
     row.names(texture)
   )
   saveRDS(swp_vals, file = ftemp)
-
-} else {
-  swp_vals <- readRDS(ftemp)
 }
 
 #--- Tests

diff --git a/vignettes/rSOILWAT2_demo.Rmd b/vignettes/rSOILWAT2_demo.Rmd
@@ -189,16 +189,14 @@ options(tinytex.verbose = TRUE)
 
 ## Create base rSOILWAT2 input object
 ```{r, input_object}
-  # Preferred option:
+  ## Quick option
+  # Note: This approach is discouraged because it is very easy to miss to
+  # set all relevant parameters and variables to site-specific values
+  sw_in__bad <- rSOILWAT2::sw_exampleData ## Don't do this!
+
+  ## Preferred option
   # All relevant site-specific parameters and variables are set to NA
   sw_in <- rSOILWAT2::swInputData()
-
-  # Quick option:
-  # This approach is discouraged because it is very easy to miss to
-  # set all relevant parameters and variables to site-specific values
-  if (FALSE) {
-    sw_in <- rSOILWAT2::sw_exampleData
-  }
 ```
 
 ## Simulation time and location
@@ -644,10 +642,9 @@ by `SOILWAT2` with the selected pedotransfer function.
   # Declare that parameter values are already estimated
   rSOILWAT2::swSite_hasSWRCp(sw_in) <- TRUE
 
-  if (FALSE) {
-    # Alternatively, set soil properties and SWRC parameters at once
-    rSOILWAT2::set_swSoils(sw_in) <- list(Layers = soil_new, SWRCp = swrcp)
-  }
+  # Alternatively (and equivalently),
+  # set soil properties and SWRC parameters with one assignment
+  rSOILWAT2::set_swSoils(sw_in) <- list(Layers = soil_new, SWRCp = swrcp)
 ```