Merge pull request #356 from DrylandEcology/feature_fun_for_rSOILWAT2

Corresponding PR to DrylandEcology/rSOILWAT2#135 (v3.0.0)

- Updates to reflect new interception equations in SOILWAT2 v5.0.0

- Moved several functions to rSOILWAT2:
* Vegetation-climate functions and associated time functions
* Functions related to soil moisture/temperature conditions and regimes, resilience and resistance categories, and associated functions

.gitattributes

@@ -0,0 +1 @@
+*.sqlite3 filter=lfs diff=lfs merge=lfs -text

.travis.yml

@@ -53,6 +53,8 @@ before_install:
   - git clone -b master --single-branch --recursive https://github.com/DrylandEcology/rSOILWAT2.git ../rSOILWAT2
   # Install rSOILWAT2 without help pages and without vignettes
   - R CMD INSTALL --no-docs --no-help ../rSOILWAT2
+  # Use git-lfs to pull reference files for package checking
+  - git lfs pull
 
 install:
   # Install rSFSW2 dependencies, but remove `Rmpi` etc.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rSFSW2
 Title: Simulation Framework for SOILWAT2
-Version: 3.1.5
-Date: 2019-03-14
+Version: 4.0.0
+Date: 2019-05-03
 Authors@R: c(
   person("Daniel", "Schlaepfer", email = "daniel.schlaepfer@yale.edu",
     comment = c(ORCID = "0000-0001-9973-2065"), role = c("aut", "cre")),
@@ -12,9 +12,9 @@ Authors@R: c(
 Description: Setting up, carrying out, and analyzing ecosystem water balance
     simulation experiments with SOILWAT2.
 Depends:
-    R (>= 3.4.0)
+    R (>= 3.5.0)
 Imports:
-    rSOILWAT2 (>= 2.3.5),
+    rSOILWAT2 (>= 3.0.0),
     RSQLite (>= 2.1.1),
     DBI (>= 1.0),
     Rcpp (>= 0.12.12),
@@ -45,7 +45,7 @@ Suggests:
     spelling (>= 1.1),
     hunspell (>= 2.9),
     covr,
-    lintr (>= 1.0.3),
+    lintr (>= 1.0.3.9000),
     goodpractice
 Remotes:
     github::dschlaep/weathergen

NAMESPACE

@@ -9,23 +9,12 @@ export(ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_dbW)
 export(ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_swWeather)
 export(ExtractGriddedDailyWeatherFromMaurer2002_NorthAmerica)
 export(ExtractGriddedDailyWeatherFromNRCan_10km_Canada)
-export(Grass_ANPP)
 export(GriddedDailyWeatherFromNCEPCFSR_Global)
 export(PrepareClimateScenarios)
-export(SMR_logic)
-export(SMR_names)
-export(SMRq_names)
-export(STR_logic)
-export(STR_names)
-export(SWPtoVWC)
-export(Shrub_ANPP)
-export(TranspCoeffByVegType)
-export(VWCtoSWP)
 export(align_with_target_grid)
 export(align_with_target_res)
 export(calc_BareSoilEvapCoefs)
 export(calc_RequestedSoilLayers)
-export(calc_SiteClimate)
 export(check_aggregated_output)
 export(check_cltool)
 export(check_lock_content)
@@ -73,8 +62,6 @@ export(downscale.deltahybrid)
 export(downscale.deltahybrid3mod)
 export(downscale.raw)
 export(enable_debug_dump)
-export(estimate_PotNatVeg_biomass)
-export(estimate_PotNatVeg_composition)
 export(exit_SFSW2_cluster)
 export(export_objects_to_workers)
 export(extract_SFSW2_cells_from_raster)

R/Aggregation_Functions.R

@@ -780,9 +780,9 @@ fields_dailyNRCS_SoilMoistureTemperatureRegimes <- function(aon, ...) { # nolint
 
   if (isTRUE(aon[[id]])) {
     temp <- paste0("NRCS_", c(
-      paste0("SoilTemperatureRegime_", STR_names()),
-      paste0("SoilMoistureRegime_", SMR_names()),
-      paste0("SoilMoistureRegimeQualifier_", SMRq_names())))
+      paste0("SoilTemperatureRegime_", rSOILWAT2::STR_names()),
+      paste0("SoilMoistureRegime_", rSOILWAT2::SMR_names()),
+      paste0("SoilMoistureRegimeQualifier_", rSOILWAT2::SMRq_names())))
   }
 
   list(aon = id, N = length(temp), fields = list(coerce_sqlNames(temp)))

R/ExtractData_ClimateDownscaling.R

@@ -565,8 +565,7 @@ applyDelta_oneYear <- function(obs, delta_ts, ppt_fun, daily, monthly,
 
   ppt_type <- match.arg(ppt_type, c(NA, "detailed", "simple"))
 
-  month <- 1 + as.POSIXlt(seq(ISOdate(obs@year, 1, 1, tz = "UTC"),
-                              ISOdate(obs@year, 12, 31, tz = "UTC"), by = "day"))$mon
+  month <- 1 + as.POSIXlt(rSOILWAT2::days_in_years(obs@year, obs@year))$mon
   ydeltas <- delta_ts[delta_ts[, "Year"] == obs@year, -(1:2)]
   add_days <- ppt_fun[month] == "+"
   mult_days <- !add_days

R/Mathematical_Functions.R

@@ -25,44 +25,8 @@ in_box <- function(xy, xbounds, ybounds, i_use) {
 }
 
 
-cut0Inf <- function(x, val = NA) {
-  x[x < 0] <- val
-  x
-}
-NAto0 <- function(x) {
-  x[is.na(x)] <- 0
-  x
-}
-finite01 <- function(x, val_low = 0, val_high = 1) {
-  x[x < 0 | is.na(x)] <- val_low
-  x[x > 1] <- val_high
-  x
-}
-
-calc.loess_coeff <- function(N, span) {
-  # prevent call to loessc.c:ehg182(104):
-  # "span too small.   fewer data values than degrees of freedom"
-  lcoef <- list(span = min(1, span), degree = 2)
-  if (span <= 1) {
-    # see R/trunk/src/library/stats/src/loessf.f:ehg136()
-    nf <- floor(lcoef$span * N) - 1
-    if (nf > 2) {
-      lcoef$degree <- 2
-    } else if (nf > 1) {
-      lcoef$degree <- 1
-    } else {
-      lcoef <- Recall(N, lcoef$span + 0.1)
-    }
-  }
-  lcoef
-}
-
-
-calc_starts <- function(x) {
-  temp1 <- rle(as.logical(x))
-  temp2 <- cumsum(c(0, temp1$lengths)) + 1
-  temp2[-length(temp2)][temp1$values]
-}
+cut0Inf <- rSOILWAT2:::cut0Inf
+finite01 <- rSOILWAT2:::finite01
 
 
 

R/Miscellaneous_Functions.R

@@ -312,118 +312,6 @@ dir_safe_create <- function(paths, showWarnings = FALSE, recursive = TRUE,
 }
 
 
-#' Calculate variables required to estimate percent C4 species in North America
-#'
-#' @return A named numeric vector of length 6.
-#' @references Teeri J.A., Stowe L.G. (1976) Climatic patterns and the
-#'   distribution of C4 grasses in North America. Oecologia, 23, 1-12.
-sw_dailyC4_TempVar <- function(dailyTempMin, dailyTempMean, simTime2) {
-
-  temp7 <- simTime2$month_ForEachUsedDay_NSadj == 7
-  Month7th_MinTemp_C <- tapply(dailyTempMin[temp7],
-    simTime2$year_ForEachUsedDay_NSadj[temp7], min)
-  FrostFree_Days <- tapply(dailyTempMin, simTime2$year_ForEachUsedDay_NSadj,
-    function(x) {
-      temp <- rle(x > 0)
-      if (any(temp$values)) max(temp$lengths[temp$values], na.rm = TRUE) else 0
-    })
-
-  # 18.333 C = 65 F with (65 - 32) * 5 / 9
-  temp_base65F <- dailyTempMean - 18.333
-  temp_base65F[temp_base65F < 0] <- 0
-  DegreeDaysAbove65F_DaysC <- tapply(temp_base65F,
-    simTime2$year_ForEachUsedDay_NSadj, sum)
-
-  # if southern Hemisphere, then 7th month of last year is not included
-  nyrs <- seq_along(Month7th_MinTemp_C)
-  temp <- cbind(Month7th_MinTemp_C[nyrs], FrostFree_Days[nyrs],
-    DegreeDaysAbove65F_DaysC[nyrs])
-  res <- c(apply(temp, 2, mean), apply(temp, 2, stats::sd))
-  temp <- c("Month7th_NSadj_MinTemp_C",
-    "LengthFreezeFreeGrowingPeriod_NSadj_Days",
-    "DegreeDaysAbove65F_NSadj_DaysC")
-  names(res) <- c(temp, paste0(temp, ".sd"))
-
-  res
-}
-
-#' Calculate climate variables from daily weather
-#'
-#' @param weatherList A list. Each element is an object of class
-#'   \code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}}
-#'   containing daily weather data of a specific year.
-#' @param year.start An integer value. The first year of the range of years for
-#'   which climate variables should be calculated.
-#' @param year.end An integer value. The last year of the range of years for
-#'   which climate variables should be calculated.
-#' @param do.C4vars A logical value. If \code{TRUE} then additional output is
-#'   returned.
-#' @param simTime2 An object as returned from function
-#'   \code{\link{simTiming_ForEachUsedTimeUnit}}. Only needed if
-#'   \code{isTRUE(do.C4vars)}.
-#'
-#' @return A list with named elements \itemize{
-#'   \item{\var{\dQuote{meanMonthlyTempC}}} {A numeric vector of length 12.
-#'    Mean monthly mean daily air temperature in degree Celsius.}
-#'   \item{\var{\dQuote{minMonthlyTempC}}} {A numeric vector of length 12.
-#'     Mean monthly minimum daily air temperature in degree Celsius.}
-#'   \item{\var{\dQuote{maxMonthlyTempC}}} {A numeric vector of length 12.
-#'     Mean monthly maximum daily air temperature in degree Celsius.}
-#'   \item{\var{\dQuote{meanMonthlyPPTcm}}} {A numeric vector of length 12.
-#'     Mean monthly precipitation in centimeters.}
-#'   \item{\var{\dQuote{MAP_cm}}} {A numeric value. Mean annual precipitation
-#'     in centimeters.}
-#'   \item{\var{\dQuote{MAT_C}}} {A numeric value. Mean annual air temperature
-#'     in degree Celsius.}
-#'   \item{\var{\dQuote{dailyTempMin}}} {A numeric vector. If
-#'     \code{isTRUE(do.C4vars)}, then minimum daily air temperature in degree
-#'     Celsius for each day of time period between \code{year.start} and
-#'     \code{year.end}. If \code{!isTRUE(do.C4vars)}, then \code{NA}.}
-#'   \item{\var{\dQuote{dailyTempMean}}} {A numeric vector. Similar as for
-#'     \code{dailyTempMin} but for mean daily air temperature.}
-#'   \item{\var{\dQuote{dailyC4vars}}} {If \code{isTRUE(do.C4vars)}, then a
-#'     named numeric vector containing the output of
-#'     \code{\link{sw_dailyC4_TempVar}}, else \code{NA}.}
-#' }
-#' @export
-calc_SiteClimate <- function(weatherList, year.start, year.end,
-  do.C4vars = FALSE, simTime2 = NULL) {
-
-  x <- rSOILWAT2::dbW_weatherData_to_dataframe(weatherList)
-
-  # Trim to years
-  years <- as.numeric(unlist(lapply(weatherList, function(x) x@year)))
-  years <- years[year.start <= years & year.end >= years]
-
-  x <- x[year.start <= x[, "Year"] & year.end >= x[, "Year"], ]
-  temp <- seq(from = ISOdate(years[1], 1, 1, tz = "UTC"),
-    to = ISOdate(years[length(years)], 12, 31, tz = "UTC"), by = "1 day")
-  xl <- list(months = as.POSIXlt(temp)$mon + 1,
-    Tmean_C = rowMeans(x[, c("Tmax_C", "Tmin_C")]))
-
-  index <- xl[["months"]] + 100 * x[, "Year"]
-  temp <- vapply(list(xl[["Tmean_C"]], x[, "Tmin_C"], x[, "Tmax_C"]),
-    function(data) matrix(tapply(data, index, mean), nrow = 12),
-    FUN.VALUE = matrix(NA_real_, nrow = 12, ncol = length(years)))
-  tempPPT <- matrix(tapply(x[, "PPT_cm"], index, sum), nrow = 12)
-
-  list(
-    meanMonthlyTempC = apply(temp[, , 1, drop = FALSE], 1, mean),
-    minMonthlyTempC = apply(temp[, , 2, drop = FALSE], 1, mean),
-    maxMonthlyTempC = apply(temp[, , 3, drop = FALSE], 1, mean),
-    meanMonthlyPPTcm = apply(tempPPT, 1, mean),
-
-    MAP_cm = sum(tempPPT) / length(years),
-    MAT_C = mean(xl[["Tmean_C"]]),
-
-    dailyTempMin = if (do.C4vars) x[, "Tmin_C"] else NA,
-    dailyTempMean = if (do.C4vars) xl[["Tmean_C"]] else NA,
-    dailyC4vars = if (do.C4vars) {
-        sw_dailyC4_TempVar(dailyTempMin = x[, "Tmin_C"],
-          dailyTempMean = xl[["Tmean_C"]], simTime2)
-      } else NA
-  )
-}
 
 
 
@@ -465,38 +353,7 @@ vpd <- function(Tmin, Tmax, RHmean = NULL) {
 }
 
 
-
-
-max_duration <- function(x, target_val = 1L, return_doys = FALSE) {
-  r <- rle(x)
-  rgood <- r$values == target_val
-  igood <- which(rgood)
-
-  if (length(igood) > 0) {
-    len <- max(r$lengths[igood])
-
-    if (return_doys) {
-      imax <- which(rgood & r$lengths == len)[1]
-
-      rdoys <- cumsum(r$lengths)
-      doys <- if (imax == 1L) {
-          c(start = 1L, end = rdoys[1])
-        } else {
-          c(start = rdoys[imax - 1] + 1,
-            end = rdoys[imax])
-        }
-    }
-
-  } else {
-    len <- 0L
-    doys <- c(start = NA, end = NA)
-  }
-
-  if (return_doys)
-    return(c(len, doys))
-
-  len
-}
+max_duration <- rSOILWAT2:::max_duration
 
 startDoyOfDuration <- function(x, duration = 10) {
   r <- rle(x)
@@ -1015,7 +872,7 @@ setup_scenarios <- function(sim_scens, future_yrs) {
 
     # ConcScen = concentration scenarios, e.g., SRESs, RCPs
     colnames(climScen) <- c("Downscaling", "DeltaStr_yrs", "ConcScen", "Model")
-    # see 'setup_simulation_time' for how 'future_yrs' is created
+    # see 'setup_time_simulation_project' for how 'future_yrs' is created
     climScen[, "Delta_yrs"] <- as.integer(substr(climScen[, "DeltaStr_yrs"], 2,
       nchar(climScen[, "DeltaStr_yrs"]) - 3))