diff --git a/.Rbuildignore b/.Rbuildignore
index 940ebe77..84a91d67 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -2,6 +2,7 @@
^CODE_OF_CONDUCT\.md$
^Meta$
^doc$
+^backup$
^data-raw$
\.git*
^\.travis\.yml$
@@ -15,20 +16,23 @@
^\.Rproj\.user$
^cran-comments\.md$
^NEWS\.md$
+tests/rSOILWAT_IntegrationTestOutput
src/SOILWAT2/\.git
+src/SOILWAT2/\.github
src/SOILWAT2/doc
-src/SOILWAT2/googletest
-src/SOILWAT2/test
-src/SOILWAT2/testing
+src/SOILWAT2/build
+src/SOILWAT2/external/googletest
+src/SOILWAT2/tests
src/SOILWAT2/\.travis\.yml
src/SOILWAT2/appveyor\.yml
src/SOILWAT2/codecov\.yml
src/SOILWAT2/Doxyfile
src/SOILWAT2/README\.md
-src/SOILWAT2/run_gcov\.sh
+src/SOILWAT2/NEWS\.md
+src/SOILWAT2/tools
src/SOILWAT2/\.LSAN_suppr\.txt
-src/SOILWAT2/SW_Main\.c
-src/SOILWAT2/SW_Output_mock\.c
+src/SOILWAT2/src/SW_Main\.c
+src/SOILWAT2/src/SW_Output_mock\.c
src/*\.o
src/*\.so
src/*\.dll
diff --git a/.gitignore b/.gitignore
index cf1e468d..e8512fee 100644
--- a/.gitignore
+++ b/.gitignore
@@ -36,6 +36,7 @@ Thumbs.db
rSOILWAT2.Rcheck
rSOILWAT_IntegrationTestOutput/
tests/spelling.Rout.save
+backup/
# Package build files
*tar.gz
@@ -49,3 +50,4 @@ doc
# Locally knitted vignettes
vignettes/*.pdf
vignettes/*.html
+vignettes/*.log
diff --git a/.lintr b/.lintr
index fba2f0d0..5658a59a 100644
--- a/.lintr
+++ b/.lintr
@@ -12,6 +12,7 @@ linters: lintr::linters_with_tags(
todo_comment_linter = NULL,
nonportable_path_linter = NULL,
expect_identical_linter = NULL,
+ function_argument_linter = NULL,
yoda_test_linter = NULL)
exclusions: list(
"R/RcppExports.R",
diff --git a/DESCRIPTION b/DESCRIPTION
index adcf9ea5..2438915f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: rSOILWAT2
-Version: 5.4.1
+Version: 6.0.0
Title: An Ecohydrological Ecosystem-Scale Water Balance Simulation Model
-Description: Access to the C-based SOILWAT2 v6.7.0 and functionality for
+Description: Access to the C-based SOILWAT2 v7.0.0 and functionality for
SQLite-database of weather data.
Authors@R: c(
person(
@@ -35,16 +35,18 @@ Suggests:
rSW2exter (>= 0.1.0),
soilDB,
spelling (>= 2.1.0),
- testthat
+ testthat (>= 3.0.0)
Remotes:
github::DrylandEcology/rSW2utils,
github::DrylandEcology/rSW2data,
github::DrylandEcology/rSW2exter
NeedsCompilation: yes
+SystemRequirements: GNU make
License: GPL-3
URL: https://github.com/DrylandEcology/rSOILWAT2
BugReports: https://github.com/DrylandEcology/rSOILWAT2/issues
Encoding: UTF-8
+Config/testthat/edition: 3
RoxygenNote: 7.2.3
LazyData: true
Language: en-US
diff --git a/NAMESPACE b/NAMESPACE
index 571135cc..8b07e24c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -16,7 +16,11 @@ export(calc_RRs_Chambers2014)
export(calc_RRs_Maestas2016)
export(calc_SMTRs)
export(calc_SiteClimate)
+export(calc_dailyInputFlags)
+export(check_SWRC_vs_PTF)
export(check_TranspirationRegions)
+export(check_ptf_availability)
+export(check_swrcp)
export(check_updatedDB)
export(check_version)
export(compare_weather)
@@ -61,6 +65,7 @@ export(dbW_upgrade_v2to3)
export(dbW_upgrade_v31to32)
export(dbW_upgrade_v3to31)
export(dbW_version)
+export(dbW_weatherData_round)
export(dbW_weatherData_to_blob)
export(dbW_weatherData_to_dataframe)
export(dbW_weatherData_to_monthly)
@@ -72,6 +77,7 @@ export(format_timestamp)
export(getStartYear)
export(getWeatherData_folders)
export(get_evaporation)
+export(get_soilmoisture)
export(get_soiltemp)
export(get_timestamp)
export(get_transpiration)
@@ -79,9 +85,14 @@ export(get_version)
export(get_years_from_weatherDF)
export(get_years_from_weatherData)
export(has_soilTemp_failed)
+export(is_missing_weather)
+export(list_matched_swrcs_ptfs)
export(lookup_annual_CO2a)
+export(nrow_output)
export(prepare_TranspirationRegions)
export(print_mkv_files)
+export(ptf_estimate)
+export(ptf_names)
export(set_Markov)
export(set_WeatherHistory)
export(set_missing_weather)
@@ -89,6 +100,7 @@ export(set_requested_flags)
export(set_swCarbon)
export(set_swCloud)
export(set_swFiles)
+export(set_swMarkov)
export(set_swOUT)
export(set_swProd)
export(set_swSWC)
@@ -99,7 +111,28 @@ export(set_swWeatherData)
export(set_swYears)
export(setup_time_simulation_run)
export(simTiming_ForEachUsedTimeUnit)
+export(swCarbon)
+export(swCloud)
+export(swEstab)
+export(swEstabSpecies)
+export(swFiles)
+export(swInputData)
+export(swLog)
+export(swMarkov)
+export(swMonthlyScalingParams)
+export(swOUT)
export(swOUT_TimeStepsForEveryKey)
+export(swOUT_key)
+export(swOutput)
+export(swOutput_KEY)
+export(swProd)
+export(swSWC)
+export(swSWC_hist)
+export(swSite)
+export(swSoils)
+export(swWeather)
+export(swWeatherData)
+export(swYears)
export(sw_Cheatgrass_ClimVar)
export(sw_dailyC4_TempVar)
export(sw_exec)
@@ -107,8 +140,19 @@ export(sw_inputData)
export(sw_inputDataFromFiles)
export(sw_out_flags)
export(sw_outputData)
+export(sw_verbosity)
+export(swrc_conversion)
+export(swrc_names)
+export(swrc_swp_to_vwc)
+export(swrc_vwc_to_swp)
+export(time_columns)
export(update_biomass)
export(update_requested_years)
+export(upgrade_weatherHistory)
+export(weatherGenerator_dataColumns)
+export(weatherHistory)
+export(weather_dataAggFun)
+export(weather_dataColumns)
exportClasses(swCarbon)
exportClasses(swCloud)
exportClasses(swEstab)
@@ -138,6 +182,7 @@ exportMethods("set_WeatherHistory<-")
exportMethods("set_swCarbon<-")
exportMethods("set_swCloud<-")
exportMethods("set_swFiles<-")
+exportMethods("set_swMarkov<-")
exportMethods("set_swOUT<-")
exportMethods("set_swProd<-")
exportMethods("set_swSWC<-")
@@ -168,6 +213,7 @@ exportMethods("swFiles_OutputPrefix<-")
exportMethods("swFiles_Prod<-")
exportMethods("swFiles_ProjDir<-")
exportMethods("swFiles_SWCsetup<-")
+exportMethods("swFiles_SWRCp<-")
exportMethods("swFiles_SiteParams<-")
exportMethods("swFiles_Soils<-")
exportMethods("swFiles_WeatherPrefix<-")
@@ -210,12 +256,16 @@ exportMethods("swSite_IntrinsicSiteParams<-")
exportMethods("swSite_ModelCoefficients<-")
exportMethods("swSite_ModelFlags<-")
exportMethods("swSite_SWClimits<-")
+exportMethods("swSite_SWRCflags<-")
exportMethods("swSite_SnowSimulationParams<-")
+exportMethods("swSite_SoilDensityInputType<-")
exportMethods("swSite_SoilTemperatureConsts<-")
exportMethods("swSite_SoilTemperatureFlag<-")
exportMethods("swSite_TranspCoefficients<-")
exportMethods("swSite_TranspirationRegions<-")
+exportMethods("swSite_hasSWRCp<-")
exportMethods("swSoils_Layers<-")
+exportMethods("swSoils_SWRCp<-")
exportMethods("swWeather_DaysRunningAverage<-")
exportMethods("swWeather_FirstYearHistorical<-")
exportMethods("swWeather_MonScalingParams<-")
@@ -233,7 +283,9 @@ exportMethods(get_Markov)
exportMethods(get_WeatherHistory)
exportMethods(get_swCarbon)
exportMethods(get_swCloud)
+exportMethods(get_swEstab)
exportMethods(get_swFiles)
+exportMethods(get_swMarkov)
exportMethods(get_swOUT)
exportMethods(get_swProd)
exportMethods(get_swSWC)
@@ -242,7 +294,6 @@ exportMethods(get_swSoils)
exportMethods(get_swWeather)
exportMethods(get_swWeatherData)
exportMethods(get_swYears)
-exportMethods(initialize)
exportMethods(swCarbon_CO2ppm)
exportMethods(swCarbon_DeltaYear)
exportMethods(swCarbon_Scenario)
@@ -265,6 +316,7 @@ exportMethods(swFiles_OutputPrefix)
exportMethods(swFiles_Prod)
exportMethods(swFiles_ProjDir)
exportMethods(swFiles_SWCsetup)
+exportMethods(swFiles_SWRCp)
exportMethods(swFiles_SiteParams)
exportMethods(swFiles_Soils)
exportMethods(swFiles_WeatherPrefix)
@@ -306,12 +358,16 @@ exportMethods(swSite_IntrinsicSiteParams)
exportMethods(swSite_ModelCoefficients)
exportMethods(swSite_ModelFlags)
exportMethods(swSite_SWClimits)
+exportMethods(swSite_SWRCflags)
exportMethods(swSite_SnowSimulationParams)
+exportMethods(swSite_SoilDensityInputType)
exportMethods(swSite_SoilTemperatureConsts)
exportMethods(swSite_SoilTemperatureFlag)
exportMethods(swSite_TranspCoefficients)
exportMethods(swSite_TranspirationRegions)
+exportMethods(swSite_hasSWRCp)
exportMethods(swSoils_Layers)
+exportMethods(swSoils_SWRCp)
exportMethods(swWeather_DaysRunningAverage)
exportMethods(swWeather_FirstYearHistorical)
exportMethods(swWeather_MonScalingParams)
@@ -325,13 +381,13 @@ exportMethods(swYears_EndYear)
exportMethods(swYears_FDOFY)
exportMethods(swYears_StartYear)
exportMethods(swYears_isNorth)
+exportMethods(sw_upgrade)
importFrom(methods,"as<-")
importFrom(methods,"slot<-")
importFrom(methods,as)
importFrom(methods,callNextMethod)
importFrom(methods,getSlots)
importFrom(methods,inheritedSlotNames)
-importFrom(methods,initialize)
importFrom(methods,new)
importFrom(methods,slot)
importFrom(methods,slotNames)
diff --git a/NEWS.md b/NEWS.md
index adf75190..6a5f432a 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,7 +1,133 @@
+# rSOILWAT2 v6.0.0
+
+## Breaking changes
+* `SOILWAT2` updated to v7.0.0
+* This version produces nearly identical simulation output
+ as the previous release under default values.
+ Small deviations arise due to
+ 1. a fix in the handling of soil moisture values
+ between field capacity and saturation;
+ 2. a fix in the calculation of potential natural vegetation; and
+ 3. a fix in the calculation of climate variables (if used).
+
+## New features
+* New method `sw_upgrade()` upgrades objects with
+ outdated `rSOILWAT2` S4 classes to the current version;
+ new `upgrade_weatherHistory()` upgrades outdated weather history objects.
+* New `get_soilmoisture()` to consistently extract soil moisture content,
+ volumetric water content (bulk soil), or
+ volumetric water content for the matric component.
+ The function calculates the requested type if not stored in the output
+ from those that are available.
+* Derived output functions `get_XXX()` gain new argument `keep_time`;
+ if `keep_time` is requested (`TRUE`), then year and sub-year time step values
+ are added as first one or two columns to the returned matrix.
+* New `time_columns()` returns the output column indices with time information.
+* New `nrow_output()` returns the number of time steps in output.
+
+* Daily weather inputs, in addition to the previous variables
+ maximum air temperature, minimum air temperature, and precipitation amount,
+ can now process the following variables (issue #229; @dschlaep, @N1ckP3rsl3y):
+ * Cloud cover (can be replaced by shortwave radiation)
+ * Wind speed (can be replaced by wind components)
+ * Wind speed eastward component (optional)
+ * Wind speed northward component (optional)
+ * Relative humidity (can be replaced by max/min humidity, specific humidity
+ dew point temperature, or vapor pressure)
+ * Maximum relative humidity (optional)
+ * Minimum relative humidity (optional)
+ * Specific humidity (optional)
+ * Dew point temperature (optional)
+ * Actual vapor pressure (optional)
+ * Downward surface shortwave radiation (optional)
+
+* This version now handles a variety of soil water retention curves `SWRC`
+ and pedotransfer functions `PTF` (issue #207, @dschlaep).
+ * New inputs are required to select a `SWRC` and `PTF` as well as to provide
+ parameter values of the selected `SWRC` for each soil layer.
+ Default values are backwards compatible, i.e.,
+ default `SWRC` is `"Campbell1974"` and
+ default `PTF` is `"Cosby1984AndOthers"`.
+ * If these new inputs are missing in an `rSOILWAT2` `swInputData` object,
+ then they are automatically set to their default values.
+ * New functionality for working with `SWRCs` and `PTFs` include
+ * `check_SWRC_vs_PTF()`
+ checks if `PTF` and `SWRC` are compatible and implemented.
+ * `check_ptf_availability()` checks availability of `PTFs`.
+ * `list_matched_swrcs_ptfs()` lists matching pairs of
+ implemented `SWRCs` and `PTFs`.
+ * `ptf_estimate()` estimates `SWRC` parameters from soil texture
+ with a pedotransfer function.
+ * `ptf_names()` lists pedotransfer functions `PTFs`.
+ * `swrc_conversion()`, `swrc_swp_to_vwc()`, and `swrc_vwc_to_swp()`
+ convert between bulk soil water content and soil water potential.
+ * `swrc_names()` lists soil water retention curves `SWRCs`.
+ * Documentation for code developers can be found in comment sections
+ `"Notes for implementing a new PTF"` and
+ `"Notes for implementing a new SWRC"`.
+
+* Soil density inputs can now represent either matric or bulk density
+ (issue #280; @dschlaep).
+ * Automatic conversion by `SOILWAT2` between matric and bulk density
+ as needed using the new slot `"SoilDensityInputType"`.
+* `calc_SiteClimate()` is now implemented via `SOILWAT2`
+ (issue #205; @N1ckP3rsl3y, @dschlaep).
+ The old implementation in R is still available as non-exported and deprecated
+ `calc_SiteClimate_old()`.
+ * This version fixes issues from the previous R version:
+ * Mean annual temperature is now the mean across years of
+ means across days within year of mean daily temperature.
+ * Years at locations in the southern hemisphere are now adjusted to start
+ on July 1 of the previous calendar year.
+ * The cheatgrass-related variables, i.e., `Month7th_PPT_mm`,
+ `MeanTemp_ofDriestQuarter_C`, and `MinTemp_of2ndMonth_C`,
+ are now adjusted for location by hemisphere.
+* `estimate_PotNatVeg_composition()` is now implemented via `SOILWAT2`
+ (issues #206, #218, #219; @N1ckP3rsl3y, @dschlaep).
+ The old implementation in R is still available as non-exported and deprecated
+ `estimate_PotNatVeg_composition_old()`.
+ * This version fixes issues from the previous R version:
+ * The `C4` grass correction based on Teeri & Stowe 1976 is now applied
+ as documented (issue #218).
+ * The sum of all grass components, if fixed, is now incorporated into
+ the total sum of all fixed components (issue #219).
+
+
+## Changes to interface
+* Class `swSite` gains new slots `"swrc_flags"` and `"has_swrcp"` and associated
+ methods `swSite_SWRCflags()` and `swSite_hasSWRCp()`
+ for names of selected `SWRC` and `PTF` as well as indicating
+ whether `SWRC` parameters are provided as inputs or to be calculated
+ at run time (issue #207, @dschlaep).
+* Class `swSoils` gains new slot `"SWRCp"` and associated methods
+ `swSoils_SWRCp()` for `SWRC` parameters by soil layer (issue #207, @dschlaep).
+* Class `swFiles` gains a new file name for the `SWRC` parameter input file and
+ associated methods `swFiles_SWRCp()` (issue #207, @dschlaep).
+* Class `swSite` gains new slot `"SoilDensityInputType"` and associated
+ methods `swSite_SoilDensityInputType()` (issue #209, @dschlaep).
+ This encodes whether soil density inputs represent
+ matric soil or bulk soil values.
+* Class `swProd` gains new slot `"veg_method"` (issue #206, @N1ckP3rsl3y).
+ This encodes if land cover is estimated at run-time by `SOILWAT2` via
+ `estimatePotNatVegComposition()` (value 1) or if land cover values are passed
+ as inputs (value 0, as previously).
+* `SWPtoVWC()` and `VWCtoSWP()` are deprecated in favor of
+ `swrc_swp_to_vwc()` and `swrc_vwc_to_swp()` respectively.
+* Class `swWeather` gains new slots (issue #229)
+ * `"use_cloudCoverMonthly"`, `"use_windSpeedMonthly"`, and
+ `"use_humidityMonthly"` which determine whether mean monthly values
+ (from `swCloud`) or daily values (from `swWeatherData`) are utilized;
+ * `"dailyInputFlags"` which indicates which of the 14 possible daily
+ weather variables are present in the inputs;
+ * `"desc_rsds"` which describes units of input shortwave radiation.
+* Class `swWeatherData` gains new columns in slot `"data"` that accommodate
+ all 14 possible daily weather variables (issue #229).
+
# rSOILWAT2 v5.4.1
* This version produces identical simulation output as the previous release.
* `get_transpiration()` and `get_evaporation()` now also work with
- `rSOILWAT2` output objects produced before `v5.0.0`.
+ `rSOILWAT2` output objects produced before `v5.0.0` (#230; @dschlaep).
+
# rSOILWAT2 v5.4.0
* `SOILWAT2` is updated to v6.7.0 which fixed vegetation establishment.
@@ -29,7 +155,7 @@
`soillayers` is specified; issue #221, @dschlaep).
* `r-lib` Github Actions updated to `v2`;
separate workflows for `R-CMD-check` and `test-coverage`
- (issue #202, @dschlaep).
+ (issue #202; @dschlaep).
# rSOILWAT2 v5.3.2
@@ -39,6 +165,7 @@
R API random number functionality which has not changed.
+
# rSOILWAT2 v5.3.1
* This version fixes a bug in soil temperature output that was
introduced with version `3.5.0` (#194).
@@ -53,10 +180,10 @@
* `SOILWAT2` is updated to `v6.5.0` which provides
the estimated minimum/maximum soil temperature for every layer and
at the surface.
-* Surface temperature is provided in slot "TEMP" in columns
+* Surface temperature is provided in slot `"TEMP"` in columns
`surfaceTemp_min_C`, `surfaceTemp_avg_C` (previously `surfaceTemp_C`),
and `surfaceTemp_max_C`.
-* Soil temperature at depths of soil layers is provided in slot "SOILTEMP"
+* Soil temperature at depths of soil layers is provided in slot `"SOILTEMP"`
in columns `Lyr_X_min_C`, `Lyr_X_avg_C` (previously `Lyr_X`),
and `Lyr_X_max_C` where `X` stands for layer number 1, 2, ...
* Package linting updated to `lintr` >= 3 and
@@ -68,7 +195,7 @@
* This version adds new output to otherwise identical simulation output.
* `SOILWAT2` is updated to `v6.4.0` which provides
the phase of soil moisture (frozen or not) in each soil layer.
-* The new output is provided in slot "FROZEN" of class `swOutput` (#101).
+* The new output is provided in slot `"FROZEN"` of class `swOutput` (#101).
# rSOILWAT2 v5.1.3
@@ -76,6 +203,7 @@
* `.dbW_setConnection()` is a bare-bones version of `dbW_setConnection()` that
quickly and without any error checking connects to a weather database.
+
# rSOILWAT2 v5.1.2
* This version produces identical simulation output as the previous release.
* `dbW_delete_duplicated_weatherData()` gains arguments
@@ -108,7 +236,7 @@
* Unsaturated percolation rate is now adjusted for `swc_min`,
i.e., percolation rate is smaller at very low moisture levels.
* Bare-soil evaporation, transpiration, and hydraulic redistribution
- no longer remove soil moisture held below swc_min.
+ no longer remove soil moisture held below `swc_min`.
* Lower limit of `swc_min` is now set at -30 MPa.
@@ -176,4 +304,4 @@
* `SOILWAT2` updated to v6.2.1
* Many improvements in documentation and unit tests.
* Closed issues and bug reports, including #58, #164, #170, #171, #176.
-* Moved CI from travis and appveyor to Github Actions.
+* Moved CI from `travis` and `appveyor` to Github Actions.
diff --git a/R/A_swGenericMethods.R b/R/A_swGenericMethods.R
index 04a50645..88fa20ac 100644
--- a/R/A_swGenericMethods.R
+++ b/R/A_swGenericMethods.R
@@ -26,6 +26,7 @@
##########################GENERIC METHODS/FUNCTIONS############################
#' \code{swReadLines}
#' @param object An object of a class such \code{\linkS4class{swInputData}}.
+#' @param file A character string. The file path.
#' @seealso \code{\linkS4class{swInputData}}
setGeneric("swReadLines", function(object, file) standardGeneric("swReadLines"))
@@ -40,21 +41,35 @@ rSW2_version <- function() {
#' @param object An object of class \code{\linkS4class{swInputData}} or
#' \code{\linkS4class{swOutput}}.
#'
+#' @return A character string representing the version number (or \code{NA}).
+#'
#' @seealso \code{\link{check_version}}
#'
#' @examples
#' get_version(rSOILWAT2::sw_exampleData)
#' get_version(sw_exec(rSOILWAT2::sw_exampleData))
+#' get_version(as.numeric_version("4.1.3"))
+#' get_version(packageVersion("rSOILWAT2"))
#'
#' @export
setGeneric("get_version", function(object) standardGeneric("get_version"))
#' @rdname get_version
setMethod(
- f = "get_version",
+ "get_version",
signature = "ANY",
definition = function(object) {
- NA
+ tmp <- try(inherits(object, "numeric_version"), silent = TRUE)
+ if (inherits(tmp, "try-error") || !isTRUE(tmp)) {
+ tmp <- try(object@version, silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ NA_character_
+ } else {
+ as.character(as.numeric_version(tmp))
+ }
+ } else {
+ as.character(object) # numeric version
+ }
}
)
@@ -153,10 +168,11 @@ setGeneric("get_timestamp", function(object) standardGeneric("get_timestamp"))
#' @rdname get_timestamp
setMethod(
- f = "get_timestamp",
+ "get_timestamp",
signature = "ANY",
definition = function(object) {
- NA
+ tmp <- try(object@timestamp, silent = TRUE)
+ if (inherits(tmp, "try-error")) NA_real_ else tmp
}
)
@@ -177,6 +193,63 @@ format_timestamp <- function(object) {
}
+#------ Upgrade sw objects to newer rSOILWAT2 versions ------
+
+#' Upgrade a `rSOILWAT2`-classed object from an older package version
+#'
+#' Missing slots and elements are added and
+#' take the new default values from `SOILWAT2`.
+#'
+#' @param object An object of a `rSOILWAT2` class.
+#' @param verbose A logical value.
+#'
+#' @return The upgraded `object`, if needed, to match the current version
+#' with missing slots and elements filled with default values.
+#'
+#' @section Details:
+#' List of changes:
+#' * Changes with `v6.0.0`:
+#' * class [`swSite-class`]:
+#' new slots `"swrc_flags"`, `"has_swrcp"`, and
+#' `"SoilDensityInputType"`
+#' * class [`swSoils-class`]: new slot `"SWRCp"`
+#' * class [`swFiles-class`]:
+#' `SWRC` parameter input file added as file 6 for a new total of 23
+#' * class [`swProd-class`]: new slot `"veg_method"`
+#' * Changes with `v5.4.0`:
+#' * classes [`swEstabSpecies-class`] and [`swEstab-class`]:
+#' new slot `"vegType"`
+#' * Changes with `v5.2.0`:
+#' * class [`swOUT-class`]:
+#' `"FROZEN"` added as `outkey` 28 for a new total of 32
+#' * Changes with `v3.1.0`:
+#' * class [`swOUT-class`]:
+#' `"BIOMASS"` added as `outkey` 31 for a new total of 31
+#' * Changes with `v2.3.0`:
+#' * class [`swOUT-class`]:
+#' `"SWA"` added as `outkey` 8 for a new total of 30
+#'
+#' @examples
+#' x <- sw_upgrade(rSOILWAT2::sw_exampleData, verbose = TRUE)
+#'
+#' @md
+#' @exportMethod sw_upgrade
+setGeneric(
+ "sw_upgrade",
+ function(object, verbose = FALSE) standardGeneric("sw_upgrade")
+)
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "ANY",
+ definition = function(object, verbose = FALSE) {
+ object
+ }
+)
+
+
+
#########FILES##########
#' \code{get_swFiles}
#' @param object An object of class \code{\linkS4class{swFiles}} or
@@ -206,7 +279,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Years", function(object) standardGeneric("swFiles_Years"))
+setGeneric(
+ "swFiles_Years",
+ function(object) standardGeneric("swFiles_Years")
+)
#' \code{swFiles_LogFile}
#' @param object An object of class \code{\linkS4class{swFiles}} or
@@ -230,7 +306,19 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Soils", function(object) standardGeneric("swFiles_Soils"))
+setGeneric(
+ "swFiles_Soils",
+ function(object) standardGeneric("swFiles_Soils")
+)
+
+#' \code{swFiles_SWRCp}
+#' @param object An object of class \code{\linkS4class{swFiles}} or
+#' \code{\linkS4class{swInputData}}.
+#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "swFiles_SWRCp",
+ function(object) standardGeneric("swFiles_SWRCp")
+)
#' \code{swFiles_WeatherSetup}
#' @param object An object of class \code{\linkS4class{swFiles}} or
@@ -263,25 +351,37 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Cloud", function(object) standardGeneric("swFiles_Cloud"))
+setGeneric(
+ "swFiles_Cloud",
+ function(object) standardGeneric("swFiles_Cloud")
+)
#' \code{swFiles_Prod}
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Prod", function(object) standardGeneric("swFiles_Prod"))
+setGeneric(
+ "swFiles_Prod",
+ function(object) standardGeneric("swFiles_Prod")
+)
#' \code{swFiles_Estab}
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Estab", function(object) standardGeneric("swFiles_Estab"))
+setGeneric(
+ "swFiles_Estab",
+ function(object) standardGeneric("swFiles_Estab")
+)
#' \code{swFiles_Carbon}
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Carbon", function(object) standardGeneric("swFiles_Carbon"))
+setGeneric(
+ "swFiles_Carbon",
+ function(object) standardGeneric("swFiles_Carbon")
+)
#' \code{swFiles_SWCsetup}
#' @param object An object of class \code{\linkS4class{swFiles}} or
@@ -296,7 +396,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
-setGeneric("swFiles_Output", function(object) standardGeneric("swFiles_Output"))
+setGeneric(
+ "swFiles_Output",
+ function(object) standardGeneric("swFiles_Output")
+)
#' \code{swFiles_WeatherPrefix}
#' @param object An object of class \code{\linkS4class{swFiles}} or
@@ -316,9 +419,12 @@ setGeneric(
function(object) standardGeneric("swFiles_OutputPrefix")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swFiles<-}} doesn't work.
#' \code{set_swFiles}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swFiles<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swFiles}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swFiles",
@@ -326,9 +432,7 @@ setGeneric(
)
#' \code{set_swFiles<-}
-#' @param object An object of class \code{\linkS4class{swFiles}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swFiles
#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swFiles<-",
@@ -395,6 +499,16 @@ setGeneric(
function(object, value) standardGeneric("swFiles_Soils<-")
)
+#' \code{swFiles_SWRCp<-}
+#' @param object An object of class \code{\linkS4class{swFiles}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
+#' @seealso \code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "swFiles_SWRCp<-",
+ function(object, value) standardGeneric("swFiles_SWRCp<-")
+)
+
#' \code{swFiles_WeatherSetup<-}
#' @param object An object of class \code{\linkS4class{swFiles}} or
#' \code{\linkS4class{swInputData}}.
@@ -511,7 +625,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swYears}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swYears}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swYears", function(object) standardGeneric("get_swYears"))
+setGeneric(
+ "get_swYears",
+ function(object) standardGeneric("get_swYears")
+)
#' \code{swYears_StartYear}
#' @param object An object of class \code{\linkS4class{swYears}} or
@@ -544,7 +661,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swYears}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swYears}} and \code{\linkS4class{swInputData}}
-setGeneric("swYears_EDOEY", function(object) standardGeneric("swYears_EDOEY"))
+setGeneric(
+ "swYears_EDOEY",
+ function(object) standardGeneric("swYears_EDOEY")
+)
#' \code{swYears_isNorth}
#' @param object An object of class \code{\linkS4class{swYears}} or
@@ -555,9 +675,14 @@ setGeneric(
function(object) standardGeneric("swYears_isNorth")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swYears<-}} doesn't work.
#' \code{set_swYears}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swYears<-}} doesn't work.
+#'
+#' @param object An object of class \code{\linkS4class{swYears}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
+#'
#' @export
setGeneric(
"set_swYears",
@@ -565,9 +690,7 @@ setGeneric(
)
#' \code{set_swYears<-}
-#' @param object An object of class \code{\linkS4class{swYears}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swYears
#' @seealso \code{\linkS4class{swYears}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swYears<-",
@@ -629,7 +752,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swWeather}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swWeather}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swWeather", function(object) standardGeneric("get_swWeather"))
+setGeneric(
+ "get_swWeather",
+ function(object) standardGeneric("get_swWeather")
+)
#' \code{swWeather_DaysRunningAverage}
#' @param object An object of class \code{\linkS4class{swWeather}} or
@@ -703,9 +829,12 @@ setGeneric(
function(object) standardGeneric("swWeather_MonScalingParams")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swWeather<-}} doesn't work.
#' \code{set_swWeather}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swWeather<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swWeather}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swWeather",
@@ -713,9 +842,7 @@ setGeneric(
)
#' \code{set_swWeather<-}
-#' @param object An object of class \code{\linkS4class{swWeather}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swWeather
#' @seealso \code{\linkS4class{swWeather}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swWeather<-",
@@ -809,37 +936,77 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swMarkov}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
-setGeneric("get_Markov", function(object) standardGeneric("get_Markov"))
+setGeneric(
+ "get_Markov",
+ function(object) standardGeneric("get_Markov")
+)
+
+#' \code{get_swMarkov}
+#' @param object An object of class \code{\linkS4class{swMarkov}} or
+#' \code{\linkS4class{swInputData}}.
+#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "get_swMarkov",
+ function(object) standardGeneric("get_swMarkov")
+)
#' \code{swMarkov_Prob}
#' @param object An object of class \code{\linkS4class{swMarkov}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
-setGeneric("swMarkov_Prob", function(object) standardGeneric("swMarkov_Prob"))
+setGeneric(
+ "swMarkov_Prob",
+ function(object) standardGeneric("swMarkov_Prob")
+)
#' \code{swMarkov_Conv}
#' @param object An object of class \code{\linkS4class{swMarkov}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
-setGeneric("swMarkov_Conv", function(object) standardGeneric("swMarkov_Conv"))
+setGeneric(
+ "swMarkov_Conv",
+ function(object) standardGeneric("swMarkov_Conv")
+)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_Markov<-}} doesn't work.
#' \code{set_Markov}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_Markov<-}} doesn't work.
-#' @export
-setGeneric("set_Markov", function(object, value) standardGeneric("set_Markov"))
-
-#' \code{set_Markov<-}
#' @param object An object of class \code{\linkS4class{swMarkov}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#' @export
+setGeneric(
+ "set_Markov",
+ function(object, value) standardGeneric("set_Markov")
+)
+
+#' \code{set_Markov<-}
+#' @inheritParams set_Markov
#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_Markov<-",
function(object, value) standardGeneric("set_Markov<-")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swMarkov<-}} doesn't work.
+#' \code{set_swMarkov}
+#' @inheritParams set_Markov
+#' @export
+setGeneric(
+ "set_swMarkov",
+ function(object, value) standardGeneric("set_swMarkov")
+)
+
+#' \code{set_swMarkov<-}
+#' @inheritParams set_Markov
+#' @seealso \code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "set_swMarkov<-",
+ function(object, value) standardGeneric("set_swMarkov<-")
+)
+
#' \code{swMarkov_Prob<-}
#' @param object An object of class \code{\linkS4class{swMarkov}} or
#' \code{\linkS4class{swInputData}}.
@@ -874,6 +1041,7 @@ setGeneric(
#' \code{get_swWeatherData}
#' @param object An object of class \code{\linkS4class{swWeatherData}} or
#' \code{\linkS4class{swInputData}}.
+#' @param year An numeric value. The calendar year.
#' @seealso \code{\linkS4class{swWeatherData}} and
#' \code{\linkS4class{swInputData}}
setGeneric(
@@ -881,9 +1049,11 @@ setGeneric(
function(object, year) standardGeneric("get_swWeatherData")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_WeatherHistory<-}} doesn't work.
#' \code{set_WeatherHistory}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_WeatherHistory<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_WeatherHistory",
@@ -891,17 +1061,19 @@ setGeneric(
)
#' \code{set_WeatherHistory<-}
-#' @param object An object of class \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_WeatherHistory
#' @seealso \code{\linkS4class{swInputData}}
setGeneric(
"set_WeatherHistory<-",
function(object, value) standardGeneric("set_WeatherHistory<-")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swWeatherData<-}} doesn't work.
#' \code{set_swWeatherData}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swWeatherData<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swWeatherData}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swWeatherData",
@@ -909,9 +1081,7 @@ setGeneric(
)
#' \code{set_swWeatherData<-}
-#' @param object An object of class \code{\linkS4class{swWeatherData}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swWeatherData
#' @seealso \code{\linkS4class{swWeatherData}} and
#' \code{\linkS4class{swInputData}}
setGeneric(
@@ -925,7 +1095,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swCloud}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swCloud}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swCloud", function(object) standardGeneric("get_swCloud"))
+setGeneric(
+ "get_swCloud",
+ function(object) standardGeneric("get_swCloud")
+)
#' \code{swCloud_SkyCover}
#' @param object An object of class \code{\linkS4class{swCloud}} or
@@ -972,9 +1145,12 @@ setGeneric(
function(object) standardGeneric("swCloud_RainEvents")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swCloud<-}} doesn't work.
#' \code{set_swCloud}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swCloud<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swCloud}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swCloud",
@@ -982,9 +1158,7 @@ setGeneric(
)
#' \code{set_swCloud<-}
-#' @param object An object of class \code{\linkS4class{swCloud}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swCloud
#' @seealso \code{\linkS4class{swCloud}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swCloud<-",
@@ -1047,7 +1221,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swProd}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swProd}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swProd", function(object) standardGeneric("get_swProd"))
+setGeneric(
+ "get_swProd",
+ function(object) standardGeneric("get_swProd")
+)
#' \code{swProd_Composition}
#' @param object An object of class \code{\linkS4class{swProd}} or
@@ -1062,7 +1239,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swProd}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swProd}} and \code{\linkS4class{swInputData}}
-setGeneric("swProd_Albedo", function(object) standardGeneric("swProd_Albedo"))
+setGeneric(
+ "swProd_Albedo",
+ function(object) standardGeneric("swProd_Albedo")
+)
#' \code{swProd_CanopyHeight}
#' @param object An object of class \code{\linkS4class{swProd}} or
@@ -1113,7 +1293,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swProd}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swProd}} and \code{\linkS4class{swInputData}}
-setGeneric("swProd_Shade", function(object) standardGeneric("swProd_Shade"))
+setGeneric(
+ "swProd_Shade",
+ function(object) standardGeneric("swProd_Shade")
+)
#' \code{swProd_HydrRedstro_use}
#' @param object An object of class \code{\linkS4class{swProd}} or
@@ -1197,16 +1380,20 @@ setGeneric(
function(object) standardGeneric("swProd_MonProd_forb")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swProd<-}} doesn't work.
#' \code{set_swProd}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swProd<-}} doesn't work.
-#' @export
-setGeneric("set_swProd", function(object, value) standardGeneric("set_swProd"))
-
-#' \code{set_swProd<-}
#' @param object An object of class \code{\linkS4class{swProd}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#' @export
+setGeneric(
+ "set_swProd",
+ function(object, value) standardGeneric("set_swProd")
+)
+
+#' \code{set_swProd<-}
+#' @inheritParams set_swProd
#' @seealso \code{\linkS4class{swProd}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swProd<-",
@@ -1390,9 +1577,44 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swSite", function(object) standardGeneric("get_swSite")
+setGeneric(
+ "get_swSite",
+ function(object) standardGeneric("get_swSite")
)
+#' Names of `SWRC` and `PTF`
+#'
+#' @param object An object of class [swSite-class] or [swInputData-class].
+#'
+#' @return A character vector with two elements `"swrc_name"` and `"ptf_name"`.
+#'
+#' @md
+#' @exportMethod swSite_SWRCflags
+setGeneric(
+ "swSite_SWRCflags",
+ function(object) standardGeneric("swSite_SWRCflags")
+)
+
+#' Are `SWRC` parameters provided in `SWRCp`?
+#'
+#' Set to `TRUE` once `SWRCp` are set.
+#'
+#' @param object An object of class [swSite-class] or [swInputData-class].
+#'
+#' @return A logical value.
+#' `TRUE` if `SWRC` parameters are provided in `SWRCp`;
+#' `FALSE` if `SWRCp` should be estimated during a simulation run
+#' via specified pedotransfer function
+#' (see `"ptf_name"` of [swSite_SWRCflags()]).
+#'
+#' @md
+#' @exportMethod swSite_hasSWRCp
+setGeneric(
+ "swSite_hasSWRCp",
+ function(object) standardGeneric("swSite_hasSWRCp")
+)
+
+
#' \code{swSite_SWClimits}
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
@@ -1483,6 +1705,16 @@ setGeneric(
function(object) standardGeneric("swSite_SoilTemperatureConsts")
)
+#' \code{swSite_SoilTemperatureFlag}
+#' @param object An object of class \code{\linkS4class{swSite}} or
+#' \code{\linkS4class{swInputData}}.
+#' @seealso \code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "swSite_SoilDensityInputType",
+ function(object) standardGeneric("swSite_SoilDensityInputType")
+)
+
+
#' \code{swSite_TranspirationRegions}
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
@@ -1492,22 +1724,48 @@ setGeneric(
function(object) standardGeneric("swSite_TranspirationRegions")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swSite<-}} doesn't work.
#' \code{set_swSite}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swSite<-}} doesn't work.
-#' @export
-setGeneric("set_swSite", function(object, value) standardGeneric("set_swSite"))
-
-#' \code{set_swSite<-}
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#' @export
+setGeneric(
+ "set_swSite",
+ function(object, value) standardGeneric("set_swSite")
+)
+
+#' \code{set_swSite<-}
+#' @inheritParams set_swSite
#' @seealso \code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swSite<-",
function(object, value) standardGeneric("set_swSite<-")
)
+#' @rdname swSite_SWRCflags
+#'
+#' @param value A character vector with two elements for
+#' `"swrc_name"` and `"ptf_name"`.
+#'
+#' @exportMethod swSite_SWRCflags<-
+#' @md
+setGeneric(
+ "swSite_SWRCflags<-",
+ function(object, value) standardGeneric("swSite_SWRCflags<-")
+)
+
+#' @rdname swSite_hasSWRCp
+#'
+#' @param value A logical value.
+#'
+#' @exportMethod swSite_hasSWRCp<-
+setGeneric(
+ "swSite_hasSWRCp<-",
+ function(object, value) standardGeneric("swSite_hasSWRCp<-")
+)
+
#' \code{swSite_SWClimits<-}
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
@@ -1608,6 +1866,16 @@ setGeneric(
function(object, value) standardGeneric("swSite_SoilTemperatureConsts<-")
)
+#' \code{swSite_SoilDensityInputType<-}
+#' @param object An object of class \code{\linkS4class{swSite}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
+#' @seealso \code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
+setGeneric(
+ "swSite_SoilDensityInputType<-",
+ function(object, value) standardGeneric("swSite_SoilDensityInputType<-")
+)
+
#' \code{swSite_TranspirationRegions<-}
#' @param object An object of class \code{\linkS4class{swSite}} or
#' \code{\linkS4class{swInputData}}.
@@ -1624,17 +1892,41 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swSoils}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swSoils", function(object) standardGeneric("get_swSoils"))
+setGeneric(
+ "get_swSoils",
+ function(object) standardGeneric("get_swSoils")
+)
-#' \code{swSoils_Layers}
-#' @param object An object of class \code{\linkS4class{swSoils}} or
-#' \code{\linkS4class{swInputData}}.
-#' @seealso \code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
-setGeneric("swSoils_Layers", function(object) standardGeneric("swSoils_Layers"))
+#' Interact with the soil layer data frame
+#'
+#' @param object An object of class [`swSoils`] or [swInputData-class].
+#'
+#' @md
+#' @exportMethod swSoils_Layers
+setGeneric(
+ "swSoils_Layers",
+ function(object) standardGeneric("swSoils_Layers")
+)
+#' `SWRC` parameters
+#'
+#' @param object An object of class [`swSoils`] or [swInputData-class].
+#'
+#' @return A data matrix.
+#'
+#' @md
+#' @exportMethod swSoils_SWRCp
+setGeneric(
+ "swSoils_SWRCp",
+ function(object) standardGeneric("swSoils_SWRCp")
+)
+
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swSoils<-}} doesn't work.
#' \code{set_swSoils}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swSoils<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swSoils}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swSoils",
@@ -1642,24 +1934,35 @@ setGeneric(
)
#' \code{set_swSoils<-}
-#' @param object An object of class \code{\linkS4class{swSoils}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swSoils
#' @seealso \code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swSoils<-",
function(object, value) standardGeneric("set_swSoils<-")
)
-#' \code{swSoils_Layers<-}
-#' @param object An object of class \code{\linkS4class{swSoils}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
-#' @seealso \code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
+#' @rdname swSoils_Layers
+#'
+#' @param value An object that can be converted to a data matrix and represents
+#' required soil layer information.
+#'
+#' @exportMethod swSoils_Layers<-
setGeneric(
"swSoils_Layers<-",
function(object, value) standardGeneric("swSoils_Layers<-")
)
+
+#' @rdname swSoils_SWRCp
+#'
+#' @param value An object that can be converted to a data matrix and represents
+#' required `SWRC` parameters.
+#'
+#' @exportMethod swSoils_SWRCp<-
+setGeneric(
+ "swSoils_SWRCp<-",
+ function(object, value) standardGeneric("swSoils_SWRCp<-")
+)
+
########################
#########ESTAB##########
@@ -1667,7 +1970,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swEstab}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swEstab}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swEstab", function(object) standardGeneric("get_swEstab"))
+setGeneric(
+ "get_swEstab",
+ function(object) standardGeneric("get_swEstab")
+)
#' \code{swEstab_useEstab}
#' @param object An object of class \code{\linkS4class{swEstab}} or
@@ -1706,7 +2012,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swCarbon}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swCarbon}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swCarbon", function(object) standardGeneric("get_swCarbon"))
+setGeneric(
+ "get_swCarbon",
+ function(object) standardGeneric("get_swCarbon")
+)
#' \code{swCarbon_Use_Bio}
#' @param object An object of class \code{\linkS4class{swCarbon}} or
@@ -1753,9 +2062,12 @@ setGeneric(
function(object) standardGeneric("swCarbon_CO2ppm")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swCarbon<-}} doesn't work.
#' \code{set_swCarbon}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swCarbon<-}} doesn't work.
+#' @param object An object of class \code{\linkS4class{swCarbon}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
#' @export
setGeneric(
"set_swCarbon",
@@ -1763,9 +2075,7 @@ setGeneric(
)
#' \code{set_swCarbon<-}
-#' @param object An object of class \code{\linkS4class{swCarbon}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams set_swCarbon
#' @seealso \code{\linkS4class{swCarbon}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swCarbon<-",
@@ -1828,19 +2138,28 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swSWC", function(object) standardGeneric("get_swSWC"))
+setGeneric(
+ "get_swSWC",
+ function(object) standardGeneric("get_swSWC")
+)
#' \code{swSWC_use}
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
-setGeneric("swSWC_use", function(object) standardGeneric("swSWC_use"))
+setGeneric(
+ "swSWC_use",
+ function(object) standardGeneric("swSWC_use")
+)
#' \code{swSWC_prefix}
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
-setGeneric("swSWC_prefix", function(object) standardGeneric("swSWC_prefix"))
+setGeneric(
+ "swSWC_prefix",
+ function(object) standardGeneric("swSWC_prefix")
+)
#' \code{swSWC_FirstYear}
#' @param object An object of class \code{\linkS4class{swSWC}} or
@@ -1855,7 +2174,10 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
-setGeneric("swSWC_Method", function(object) standardGeneric("swSWC_Method"))
+setGeneric(
+ "swSWC_Method",
+ function(object) standardGeneric("swSWC_Method")
+)
#' \code{swSWC_HistoricList}
#' @param object An object of class \code{\linkS4class{swSWC}} or
@@ -1869,22 +2191,27 @@ setGeneric(
#' \code{swSWC_HistoricData}
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
+#' @param year An numeric value. The calendar year.
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
setGeneric(
"swSWC_HistoricData",
function(object, year) standardGeneric("swSWC_HistoricData")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swSWC<-}} doesn't work.
#' \code{set_swSWC}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swSWC<-}} doesn't work.
-#' @export
-setGeneric("set_swSWC", function(object, value) standardGeneric("set_swSWC"))
-
-#' \code{set_swSWC<-}
#' @param object An object of class \code{\linkS4class{swSWC}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#' @export
+setGeneric(
+ "set_swSWC",
+ function(object, value) standardGeneric("set_swSWC")
+)
+
+#' \code{set_swSWC<-}
+#' @inheritParams set_swSWC
#' @seealso \code{\linkS4class{swSWC}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swSWC<-",
@@ -1957,13 +2284,19 @@ setGeneric(
#' @param object An object of class \code{\linkS4class{swOUT}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swOUT}} and \code{\linkS4class{swInputData}}
-setGeneric("get_swOUT", function(object) standardGeneric("get_swOUT"))
+setGeneric(
+ "get_swOUT",
+ function(object) standardGeneric("get_swOUT")
+)
#' \code{swOUT_TimeStep}
#' @param object An object of class \code{\linkS4class{swOUT}} or
#' \code{\linkS4class{swInputData}}.
#' @seealso \code{\linkS4class{swOUT}} and \code{\linkS4class{swInputData}}
-setGeneric("swOUT_TimeStep", function(object) standardGeneric("swOUT_TimeStep"))
+setGeneric(
+ "swOUT_TimeStep",
+ function(object) standardGeneric("swOUT_TimeStep")
+)
#' \code{swOUT_OutputSeparator}
#' @param object An object of class \code{\linkS4class{swOUT}} or
@@ -1974,16 +2307,20 @@ setGeneric(
function(object) standardGeneric("swOUT_OutputSeparator")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{set_swOUT<-}} doesn't work.
#' \code{set_swOUT}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{set_swOUT<-}} doesn't work.
-#' @export
-setGeneric("set_swOUT", function(object, value) standardGeneric("set_swOUT"))
-
-#' \code{set_swOUT<-}
#' @param object An object of class \code{\linkS4class{swOUT}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#' @export
+setGeneric(
+ "set_swOUT",
+ function(object, value) standardGeneric("set_swOUT")
+)
+
+#' \code{set_swOUT<-}
+#' @inheritParams set_swOUT
#' @seealso \code{\linkS4class{swOUT}} and \code{\linkS4class{swInputData}}
setGeneric(
"set_swOUT<-",
@@ -2000,9 +2337,14 @@ setGeneric(
function(object, value) standardGeneric("swOUT_TimeStep<-")
)
+# Need to define and export this generic method -- otherwise,
+# \code{\link{swOUT_TimeStepsForEveryKey<-}} doesn't work.
#' \code{swOUT_TimeStepsForEveryKey}
-#' Need to define and export this generic method -- otherwise,
-#' \code{\link{swOUT_TimeStepsForEveryKey<-}} doesn't work.
+#'
+#' @param object An object of class \code{\linkS4class{swOUT}} or
+#' \code{\linkS4class{swInputData}}.
+#' @param value A value to assign to a specific slot of the \code{object}.
+#'
#' @export
setGeneric(
"swOUT_TimeStepsForEveryKey",
@@ -2010,9 +2352,7 @@ setGeneric(
)
#' \code{swOUT_TimeStepsForEveryKey<-}
-#' @param object An object of class \code{\linkS4class{swOUT}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams swOUT_TimeStepsForEveryKey
#' @seealso \code{\linkS4class{swOUT}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOUT_TimeStepsForEveryKey<-",
@@ -2030,20 +2370,27 @@ setGeneric(
)
#' Activate/deactivate an output slot (\var{swOUT_OutKey})
+#'
#' @param object An object of class \code{\linkS4class{swOUT}} or
#' \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the \code{object}.
+#'
#' @seealso
#' \code{\linkS4class{swOUT}}, \code{\linkS4class{swInputData}}, and
#' \code{\link{sw_exec}}
-#' @aliases activate_swOUT_OutKey, deactivate_swOUT_OutKey
-#' @name activate_swOUT_OutKey
+#'
+#' @aliases activate_swOUT_OutKey
+#' deactivate_swOUT_OutKey deactivate_swOUT_OutKey-set
+#' @name activate_swOUT_OutKey-set
+NULL
+
+#' @rdname activate_swOUT_OutKey-set
setGeneric(
"activate_swOUT_OutKey<-",
function(object, value) standardGeneric("activate_swOUT_OutKey<-")
)
-#' @rdname activate_swOUT_OutKey
+#' @rdname activate_swOUT_OutKey-set
setGeneric(
"deactivate_swOUT_OutKey<-",
function(object, value) standardGeneric("deactivate_swOUT_OutKey<-")
@@ -2067,6 +2414,8 @@ setGeneric(
#' \code{swOutput_getKEY}
#' @param object An object of class \code{\linkS4class{swOutput}} or
#' \code{\linkS4class{swInputData}}.
+#' @param index An integer value. The "key" (slot) position.
+#'
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_getKEY",
@@ -2074,8 +2423,7 @@ setGeneric(
)
#' \code{swOutput_KEY_Period}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
+#' @inheritParams swOutput_getKEY
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_Period",
@@ -2083,8 +2431,7 @@ setGeneric(
)
#' \code{swOutput_KEY_TimeStep}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
+#' @inheritParams swOutput_getKEY
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_TimeStep",
@@ -2092,8 +2439,7 @@ setGeneric(
)
#' \code{swOutput_KEY_Columns}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
+#' @inheritParams swOutput_getKEY
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_Columns",
@@ -2101,8 +2447,7 @@ setGeneric(
)
#' \code{swOutput_setKEY<-}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
+#' @inheritParams swOutput_getKEY
#' @param value A value to assign to a specific slot of the \code{object}.
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
@@ -2111,9 +2456,7 @@ setGeneric(
)
#' \code{swOutput_KEY_Period<-}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams swOutput_setKEY<-
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_Period<-",
@@ -2121,9 +2464,7 @@ setGeneric(
)
#' \code{swOutput_KEY_TimeStep<-}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams swOutput_setKEY<-
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_TimeStep<-",
@@ -2131,9 +2472,7 @@ setGeneric(
)
#' \code{swOutput_KEY_Columns<-}
-#' @param object An object of class \code{\linkS4class{swOutput}} or
-#' \code{\linkS4class{swInputData}}.
-#' @param value A value to assign to a specific slot of the \code{object}.
+#' @inheritParams swOutput_setKEY<-
#' @seealso \code{\linkS4class{swOutput}} and \code{\linkS4class{swInputData}}
setGeneric(
"swOutput_KEY_Columns<-",
diff --git a/R/B_swFiles.R b/R/B_swFiles.R
index 4d7f489a..5d2e6f34 100644
--- a/R/B_swFiles.R
+++ b/R/B_swFiles.R
@@ -28,10 +28,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swFiles}}.
-#' @param .Object An object of class \code{\linkS4class{swFiles}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swYears}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -44,179 +50,365 @@
#' @examples
#' showClass("swFiles")
#' x <- new("swFiles")
+#' x <- swFiles()
#'
#' @name swFiles-class
#' @export
-setClass("swFiles", slots = c(ProjDir = "character", InFiles = "character",
- WeatherPrefix = "character", OutputPrefix = "character"))
-
-#' @rdname swFiles-class
-#' @export
-setMethod("initialize", signature = "swFiles", function(.Object, ...) {
+setClass(
+ "swFiles",
+ slots = c(
+ ProjDir = "character",
+ InFiles = "character",
+ WeatherPrefix = "character",
+ OutputPrefix = "character"
+ ),
+ prototype = list(
+ ProjDir = NA_character_,
+ # 23 must be equal to rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_NFILES"]]
+ InFiles = rep(NA_character_, 23),
+ WeatherPrefix = NA_character_,
+ OutputPrefix = NA_character_
+ )
+)
+
+#' @rdname swFiles-class
+#' @export
+swFiles <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "files")
- sns <- slotNames(def)
+ sns <- slotNames("swFiles")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swFiles")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- if (FALSE) {
- # currently not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ do.call("new", args = c("swFiles", tmp))
+}
- validObject(.Object)
- .Object
-})
-swFiles_validity <- function(object) {
- val <- TRUE
+setValidity(
+ "swFiles",
+ function(object) {
+ val <- TRUE
- if (length(object@ProjDir) != 1) {
- msg <- "There must be exactly one @ProjDir value."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(object@ProjDir) != 1L) {
+ msg <- "There must be exactly one @ProjDir value."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@InFiles) !=
- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_NFILES"]]) {
- msg <- "The number of (non-empty) @InFiles must be SW_NFILES."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ length(object@InFiles) !=
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_NFILES"]]
+ ) {
+ msg <- "The number of (non-empty) @InFiles must be SW_NFILES."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@WeatherPrefix) != 1L) {
+ msg <- "There must be exactly one @WeatherPrefix value."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@OutputPrefix) != 1L) {
+ msg <- "There must be exactly one @OutputPrefix value."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@WeatherPrefix) != 1 || nchar(object@WeatherPrefix) == 0) {
- msg <- "There must be exactly one non-empty @WeatherPrefix value."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ val
}
+)
+
+
+
+#' @rdname sw_upgrade
+#' @export
+setMethod(
+ "sw_upgrade",
+ signature = "swFiles",
+ definition = function(object, verbose = FALSE) {
+ #--- Compare available and expected number of files
+ n_exp <- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_NFILES"]]
+ n_has <- length(object@InFiles)
+
+
+ #--- Identify upgrade(s)
+ # Maintenance:
+ # update `do_upgrade` when `n_exp` changes or new upgrades required!
+ do_upgrade <- c(
+ from_v230 = n_has == 22L && n_exp %in% 23L
+ )
+
+ do_upgrade <- do_upgrade[do_upgrade]
+
+ if (any(do_upgrade)) {
+ target <- swFiles()
+ stopifnot(nrow(target) == n_exp)
+
+
+ #--- Loop over upgrades sequentially
+ for (k in seq_along(do_upgrade)) {
+
+ if (verbose) {
+ message(
+ "Upgrading object of class `swFiles`: ",
+ shQuote(names(do_upgrade)[k])
+ )
+ }
+
+ # Maintenance: update `switch` when `n_exp` changes!
+ id_new <- switch(
+ EXPR = names(do_upgrade)[k],
+ from_v230 = 6L,
+ stop(
+ "Upgrade ", shQuote(names(do_upgrade)[k]),
+ " is not implemented for class `swFiles`."
+ )
+ )
- if (length(object@OutputPrefix) != 1) {
- msg <- "There must be exactly one @OutputPrefix value."
- val <- if (isTRUE(val)) msg else c(val, msg)
+
+ #--- Upgrade `InFiles`
+ object@InFiles <- c(
+ if (id_new > 1L) {
+ object@InFiles[1L:(id_new - 1L)]
+ },
+ target@InFiles[id_new],
+ if (id_new <= n_has) {
+ object@InFiles[id_new:n_has]
+ }
+ )
+ }
+
+
+ #--- Check validity and return
+ validObject(object)
+ }
+
+ object
}
+)
- val
-}
-setValidity("swFiles", swFiles_validity)
+#' @rdname swFiles-class
+#' @export
+setMethod(
+ "swFiles_ProjDir",
+ "swFiles",
+ function(object) object@ProjDir
+)
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_ProjDir", "swFiles", function(object) {
- object@ProjDir
-})
+setMethod(
+ "swFiles_WeatherPrefix",
+ "swFiles",
+ function(object) object@WeatherPrefix
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_WeatherPrefix", "swFiles", function(object) {
- object@WeatherPrefix
-})
+setMethod(
+ "swFiles_OutputPrefix",
+ "swFiles",
+ function(object) object@OutputPrefix
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_OutputPrefix", "swFiles", function(object) {
- object@OutputPrefix
-})
+setMethod(
+ "swFiles_filesIn",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eFirst"]]]
+ }
+)
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_filesIn", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eFirst"]]]
-})
+setMethod(
+ "swFiles_Years",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eModel"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Years", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eModel"]]]
-})
+setMethod(
+ "swFiles_LogFile",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eLog"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_LogFile", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eLog"]]]
-})
+setMethod(
+ "swFiles_SiteParams",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSite"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_SiteParams", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSite"]]]
-})
+setMethod(
+ "swFiles_Soils",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eLayers"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Soils", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eLayers"]]]
-})
+setMethod(
+ "swFiles_SWRCp",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSWRCp"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_WeatherSetup", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eWeather"]]]
-})
+setMethod(
+ "swFiles_WeatherSetup",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eWeather"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_MarkovProbs", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eMarkovProb"]]]
-})
+setMethod(
+ "swFiles_MarkovProbs",
+ "swFiles",
+ function(object) {
+ object@InFiles[
+ 1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eMarkovProb"]]
+ ]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_MarkovCov", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eMarkovCov"]]]
-})
+setMethod(
+ "swFiles_MarkovCov",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eMarkovCov"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Cloud", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSky"]]]
-})
+setMethod(
+ "swFiles_Cloud",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSky"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Prod", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eVegProd"]]]
-})
+setMethod(
+ "swFiles_Prod",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eVegProd"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Estab", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eVegEstab"]]]
-})
+setMethod(
+ "swFiles_Estab",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eVegEstab"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_SWCsetup", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSoilwat"]]]
-})
+setMethod(
+ "swFiles_SWCsetup",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eSoilwat"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Carbon", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eCarbon"]]]
-})
+setMethod(
+ "swFiles_Carbon",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eCarbon"]]]
+ }
+)
+
#' @rdname swFiles-class
#' @export
-setMethod("swFiles_Output", "swFiles", function(object) {
- object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eOutput"]]]
-})
+setMethod(
+ "swFiles_Output",
+ "swFiles",
+ function(object) {
+ object@InFiles[1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][["eOutput"]]]
+ }
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_ProjDir", signature = "swFiles",
+setReplaceMethod(
+ "swFiles_ProjDir",
+ signature = "swFiles",
function(object, value) {
-
- object@ProjDir <- value
- validObject(object)
- object
-})
+ object@ProjDir <- value
+ validObject(object)
+ object
+ }
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_WeatherPrefix", signature = "swFiles",
+setReplaceMethod(
+ "swFiles_WeatherPrefix",
+ signature = "swFiles",
function(object, value) {
-
- object@WeatherPrefix <- value
- validObject(object)
- object
-})
+ object@WeatherPrefix <- value
+ validObject(object)
+ object
+ }
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_OutputPrefix", signature = "swFiles",
+setReplaceMethod(
+ "swFiles_OutputPrefix",
+ signature = "swFiles",
function(object, value) {
+ object@OutputPrefix <- value
+ validObject(object)
+ object
+ }
+)
- object@OutputPrefix <- value
- validObject(object)
- object
-})
set_InFiles <- function(object, eID, value) {
id <- 1 + rSW2_glovars[["kSOILWAT2"]][["InFiles"]][[eID]]
@@ -226,79 +418,131 @@ set_InFiles <- function(object, eID, value) {
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_filesIn", signature = "swFiles",
- function(object, value) set_InFiles(object, "eFirst", value))
+setReplaceMethod(
+ "swFiles_filesIn",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eFirst", value)
+)
+
+#' @rdname swFiles-class
+#' @export
+setReplaceMethod(
+ "swFiles_Years",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eModel", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Years", signature = "swFiles",
- function(object, value) set_InFiles(object, "eModel", value))
+setReplaceMethod(
+ "swFiles_LogFile",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eLog", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_LogFile", signature = "swFiles",
- function(object, value) set_InFiles(object, "eLog", value))
+setReplaceMethod(
+ "swFiles_SiteParams",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eSite", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_SiteParams", signature = "swFiles",
- function(object, value) set_InFiles(object, "eSite", value))
+setReplaceMethod(
+ "swFiles_Soils",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eLayers", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Soils", signature = "swFiles",
- function(object, value) set_InFiles(object, "eLayers", value))
+setReplaceMethod(
+ "swFiles_SWRCp",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eSWRCp", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_WeatherSetup", signature = "swFiles",
- function(object, value) set_InFiles(object, "eWeather", value))
+setReplaceMethod(
+ "swFiles_WeatherSetup",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eWeather", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_MarkovProbs", signature = "swFiles",
- function(object, value) set_InFiles(object, "eMarkovProb", value))
+setReplaceMethod(
+ "swFiles_MarkovProbs",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eMarkovProb", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_MarkovCov", signature = "swFiles",
- function(object, value) set_InFiles(object, "eMarkovCov", value))
+setReplaceMethod(
+ "swFiles_MarkovCov",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eMarkovCov", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Cloud", signature = "swFiles",
- function(object, value) set_InFiles(object, "eSky", value))
+setReplaceMethod(
+ "swFiles_Cloud",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eSky", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Prod", signature = "swFiles",
- function(object, value) set_InFiles(object, "eVegProd", value))
+setReplaceMethod(
+ "swFiles_Prod",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eVegProd", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Estab", signature = "swFiles",
- function(object, value) set_InFiles(object, "eVegEstab", value))
+setReplaceMethod(
+ "swFiles_Estab",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eVegEstab", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_SWCsetup", signature = "swFiles",
- function(object, value) set_InFiles(object, "eSoilwat", value))
+setReplaceMethod(
+ "swFiles_SWCsetup",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eSoilwat", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Carbon", signature = "swFiles",
- function(object, value) set_InFiles(object, "eCarbon", value))
+setReplaceMethod(
+ "swFiles_Carbon",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eCarbon", value)
+)
#' @rdname swFiles-class
#' @export
-setReplaceMethod("swFiles_Output", signature = "swFiles",
- function(object, value) set_InFiles(object, "eOutput", value))
+setReplaceMethod(
+ "swFiles_Output",
+ signature = "swFiles",
+ function(object, value) set_InFiles(object, "eOutput", value)
+)
#' @rdname swFiles-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object = "swFiles", file = "character"),
+setMethod(
+ "swReadLines",
+ signature = c(object = "swFiles", file = "character"),
function(object, file) {
print(paste("TODO: method 'swReadLines' is not up-to-date;",
"hard-coded indices are incorrect"))
diff --git a/R/C_swYears.R b/R/C_swYears.R
index 2c978402..88996d30 100644
--- a/R/C_swYears.R
+++ b/R/C_swYears.R
@@ -30,10 +30,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swYears}}.
-#' @param .Object An object of class \code{\linkS4class{swYears}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -45,18 +51,38 @@
#' @examples
#' showClass("swYears")
#' x <- new("swYears")
+#' x <- swYears()
#'
#' @name swYears-class
#' @export
-setClass("swYears", slots = c(StartYear = "integer", EndYear = "integer",
- FDOFY = "integer", EDOEY = "integer", isNorth = "logical"))
+setClass(
+ "swYears",
+ slots = c(
+ StartYear = "integer",
+ EndYear = "integer",
+ FDOFY = "integer",
+ EDOEY = "integer",
+ isNorth = "logical"
+ ),
+ prototype = list(
+ StartYear = NA_integer_,
+ EndYear = NA_integer_,
+ FDOFY = 1L,
+ EDOEY = 365L,
+ isNorth = TRUE
+ )
+)
#' @rdname swYears-class
#' @export
-setMethod("initialize", signature = "swYears", function(.Object, ...) {
+swYears <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "years")
- sns <- slotNames(def)
+ sns <- slotNames("swYears")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swYears")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
# We don't set values for slots `StartYear` and `EndYear` if not passed
@@ -65,60 +91,78 @@ setMethod("initialize", signature = "swYears", function(.Object, ...) {
if (!("StartYear" %in% dns)) def@StartYear <- NA_integer_
if (!("EndYear" %in% dns)) def@EndYear <- NA_integer_
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ do.call("new", args = c("swYears", tmp))
+}
- validObject(.Object)
- .Object
-})
-swYears_validity <- function(object) {
- val <- TRUE
+setValidity(
+ "swYears",
+ function(object) {
+ val <- TRUE
- if (length(object@StartYear) != 1 ||
- (!anyNA(object@StartYear) && isTRUE(object@StartYear < 0))) {
- msg <- "There must be exactly one NA or non-negative @StartYear value."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ length(object@StartYear) != 1L ||
+ (!anyNA(object@StartYear) && isTRUE(object@StartYear < 0L))
+ ) {
+ msg <- "There must be exactly one NA or non-negative @StartYear value."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@EndYear) != 1 ||
- (!anyNA(object@EndYear) && isTRUE(object@EndYear < 0)) ||
- (!anyNA(object@EndYear) && !anyNA(object@StartYear) &&
- isTRUE(object@EndYear < object@StartYear))) {
- msg <- paste("There must be exactly NA or one non-negative @EndYear value ",
- "that is not smaller than @StartYear.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ length(object@EndYear) != 1L ||
+ (!anyNA(object@EndYear) && isTRUE(object@EndYear < 0L)) ||
+ (!anyNA(object@EndYear) && !anyNA(object@StartYear) &&
+ isTRUE(object@EndYear < object@StartYear))
+ ) {
+ msg <- paste(
+ "There must be exactly NA or one non-negative @EndYear value ",
+ "that is not smaller than @StartYear."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@FDOFY) != 1 || !is.finite(object@FDOFY) ||
- object@FDOFY < 0 ||
- object@FDOFY > 365) {
- msg <- paste("There must be exactly one non-negative finite @FDOFY value",
- "that is smaller than day 366.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ length(object@FDOFY) != 1L ||
+ !is.finite(object@FDOFY) ||
+ object@FDOFY < 0L ||
+ object@FDOFY > 365L
+ ) {
+ msg <- paste(
+ "There must be exactly one non-negative finite @FDOFY value",
+ "that is smaller than day 366."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@EDOEY) != 1 || !is.finite(object@EDOEY) ||
- object@EDOEY < 0 || object@EDOEY > 366 || object@EDOEY < object@FDOFY) {
- msg <- paste("There must be exactly one non-negative finite @EDOEY value",
- "that is not larger than day 366 and larger than @FDOFY.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ length(object@EDOEY) != 1L ||
+ !is.finite(object@EDOEY) ||
+ object@EDOEY < 0L ||
+ object@EDOEY > 366L ||
+ object@EDOEY < object@FDOFY
+ ) {
+ msg <- paste(
+ "There must be exactly one non-negative finite @EDOEY value",
+ "that is not larger than day 366 and larger than @FDOFY."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@isNorth) != 1 || is.na(object@isNorth)) {
- msg <- paste("There must be exactly one non-NA logical @isNorth value.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(object@isNorth) != 1L || is.na(object@isNorth)) {
+ msg <- "There must be exactly one non-NA logical @isNorth value."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- val
-}
-setValidity("swYears", swYears_validity)
+ val
+ }
+)
@@ -142,56 +186,73 @@ setMethod("swYears_isNorth", "swYears", function(object) object@isNorth)
#' @rdname swYears-class
#' @export
-setReplaceMethod("swYears_StartYear", signature = "swYears",
+setReplaceMethod(
+ "swYears_StartYear",
+ signature = "swYears",
function(object, value) {
object@StartYear <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swYears-class
#' @export
-setReplaceMethod("swYears_EndYear", signature = "swYears",
+setReplaceMethod(
+ "swYears_EndYear",
+ signature = "swYears",
function(object, value) {
object@EndYear <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swYears-class
#' @export
-setReplaceMethod("swYears_FDOFY", signature = "swYears",
+setReplaceMethod(
+ "swYears_FDOFY",
+ signature = "swYears",
function(object, value) {
object@FDOFY <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swYears-class
#' @export
-setReplaceMethod("swYears_EDOEY", signature = "swYears",
+setReplaceMethod(
+ "swYears_EDOEY",
+ signature = "swYears",
function(object, value) {
- object@EDOEY <- as.integer(value)
- validObject(object)
- object
-})
+ object@EDOEY <- as.integer(value)
+ validObject(object)
+ object
+ }
+)
#' @rdname swYears-class
#' @export
-setReplaceMethod("swYears_isNorth", signature = "swYears",
+setReplaceMethod(
+ "swYears_isNorth",
+ signature = "swYears",
function(object, value) {
- object@isNorth <- as.logical(value)
- validObject(object)
- object
-})
+ object@isNorth <- as.logical(value)
+ validObject(object)
+ object
+ }
+)
#' @rdname swYears-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object = "swYears", file = "character"),
+setMethod(
+ "swReadLines",
+ signature = c(object = "swYears", file = "character"),
function(object, file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
+ stop("swReadLines is defunct")
infiletext <- readLines(con = file)
object@StartYear <- readInteger(infiletext[4])
object@EndYear <- readInteger(infiletext[5])
diff --git a/R/D_swCarbon.R b/R/D_swCarbon.R
index 041ba173..06cfef26 100644
--- a/R/D_swCarbon.R
+++ b/R/D_swCarbon.R
@@ -27,9 +27,15 @@
#' simulate the effects of atmospheric carbon dioxide.
#'
#' @param object An object of class \code{\linkS4class{swCarbon}}.
-#' @param .Object An object of class \code{\linkS4class{swCarbon}}.
#' @param value A value to assign to a specific slot of the object.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @slot CarbonUseBio Object of class \code{"integer"}, where a value of 1
#' enables the \var{CO2} biomass multiplier.
@@ -49,6 +55,7 @@
#' @examples
#' showClass("swCarbon")
#' x <- new("swCarbon")
+#' x <- swCarbon()
#'
#' @name swCarbon-class
#' @export
@@ -60,70 +67,84 @@ setClass(
Scenario = "character",
DeltaYear = "integer",
CO2ppm = "matrix"
+ ),
+ prototype = list(
+ CarbonUseBio = NA_integer_,
+ CarbonUseWUE = NA_integer_,
+ Scenario = NA_character_,
+ DeltaYear = NA_integer_,
+ CO2ppm = array(
+ NA_real_,
+ dim = c(0, 2),
+ dimnames = list(NULL, c("Year", "CO2ppm"))
+ )
)
)
#' @rdname swCarbon-class
#' @export
-setMethod(
- "initialize",
- signature = "swCarbon",
- function(.Object, ...) {
- def <- slot(rSOILWAT2::sw_exampleData, "carbon")
- sns <- slotNames(def)
- dots <- list(...)
- dns <- names(dots)
-
- if ("CO2ppm" %in% dns) {
- # Guarantee dimnames
- dimnames(dots[["CO2ppm"]]) <- dimnames(def@CO2ppm)
- }
+swCarbon <- function(...) {
+ def <- slot(rSOILWAT2::sw_exampleData, "carbon")
+ sns <- slotNames("swCarbon")
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swCarbon")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
+ dns <- names(dots)
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Guarantee names
+ if ("CO2ppm" %in% dns) {
+ dimnames(dots[["CO2ppm"]]) <- list(NULL, colnames(def@CO2ppm))
+ }
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- validObject(.Object)
- .Object
- }
-)
+ do.call("new", args = c("swCarbon", tmp))
+}
-setValidity("swCarbon", function(object) {
- val <- TRUE
- if (!all(c("Year", "CO2ppm") == colnames(object@CO2ppm)) ||
- length(colnames(object@CO2ppm)) != 2) {
- msg <- "@CO2ppm: column names must be 'Year' and 'CO2ppm'"
- val <- if (isTRUE(val)) msg else c(val, msg)
+setValidity(
+ "swCarbon",
+ function(object) {
+ val <- TRUE
- } else {
- is_bad <- any(is.na(object@CO2ppm[, "Year"]) |
- round(object@CO2ppm[, "Year"]) != object@CO2ppm[, "Year"])
- if (is_bad) {
- msg <- "@CO2ppm: has missing and/or non-integer-like years"
+ if (!all(c("Year", "CO2ppm") == colnames(object@CO2ppm)) ||
+ length(colnames(object@CO2ppm)) != 2) {
+ msg <- "@CO2ppm: column names must be 'Year' and 'CO2ppm'"
val <- if (isTRUE(val)) msg else c(val, msg)
- }
- is_bad <- !all(diff(object@CO2ppm[, "Year"]) == 1)
- if (is_bad) {
- msg <- "@CO2ppm: years are not consecutive"
- val <- if (isTRUE(val)) msg else c(val, msg)
+ } else {
+ is_bad <-
+ is.na(object@CO2ppm[, "Year"]) |
+ round(object@CO2ppm[, "Year"]) != object@CO2ppm[, "Year"]
+ if (any(is_bad)) {
+ msg <- "@CO2ppm: has missing and/or non-integer-like years"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ is_bad <- !all(diff(object@CO2ppm[, "Year"]) == 1)
+ if (is_bad) {
+ msg <- "@CO2ppm: years are not consecutive"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ ids_bad <-
+ is.na(object@CO2ppm[, "CO2ppm"]) | object@CO2ppm[, "CO2ppm"] < 0
+ if (any(ids_bad)) {
+ msg <- "@CO2ppm: has missing and/or negative CO2-concentration values"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
}
- ids_bad <- is.na(object@CO2ppm[, "CO2ppm"]) | object@CO2ppm[, "CO2ppm"] < 0
- if (any(ids_bad)) {
- msg <- "@CO2ppm: has missing and/or negative CO2-concentration values"
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ val
}
-
- val
-})
+)
#' @rdname swCarbon-class
#' @export
@@ -146,55 +167,73 @@ setMethod("swCarbon_CO2ppm", "swCarbon", function(object) object@CO2ppm)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("set_swCarbon", signature = "swCarbon",
+setReplaceMethod(
+ "set_swCarbon",
+ signature = "swCarbon",
function(object, value) {
object <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("swCarbon_Use_Bio", signature = "swCarbon",
+setReplaceMethod(
+ "swCarbon_Use_Bio",
+ signature = "swCarbon",
function(object, value) {
object@CarbonUseBio <- as.integer(as.logical(value))
validObject(object)
object
-})
+ }
+)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("swCarbon_Use_WUE", signature = "swCarbon",
+setReplaceMethod(
+ "swCarbon_Use_WUE",
+ signature = "swCarbon",
function(object, value) {
object@CarbonUseWUE <- as.integer(as.logical(value))
validObject(object)
object
-})
+ }
+)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("swCarbon_Scenario", signature = "swCarbon",
+setReplaceMethod(
+ "swCarbon_Scenario",
+ signature = "swCarbon",
function(object, value) {
object@Scenario <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("swCarbon_DeltaYear", signature = "swCarbon",
+setReplaceMethod(
+ "swCarbon_DeltaYear",
+ signature = "swCarbon",
function(object, value) {
object@DeltaYear <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swCarbon-class
#' @export
-setReplaceMethod("swCarbon_CO2ppm", signature = "swCarbon",
+setReplaceMethod(
+ "swCarbon_CO2ppm",
+ signature = "swCarbon",
function(object, value) {
colnames(value) <- colnames(object@CO2ppm)
- object@CO2ppm <- value
+ object@CO2ppm <- data.matrix(value)
validObject(object)
object
-})
+ }
+)
diff --git a/R/D_swCloud.R b/R/D_swCloud.R
index 219866bf..ca09fd56 100644
--- a/R/D_swCloud.R
+++ b/R/D_swCloud.R
@@ -31,10 +31,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swCloud}}.
-#' @param .Object An object of class \code{\linkS4class{swCloud}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swInputData}}
@@ -46,93 +52,115 @@
#' @examples
#' showClass("swCloud")
#' x <- new("swCloud")
+#' x <- swCloud()
#'
#' @name swCloud-class
#' @export
-setClass("swCloud", slots = c(Cloud = "matrix"))
+setClass(
+ "swCloud",
+ slots = c(Cloud = "matrix"),
+ prototype = list(
+ Cloud = array(
+ NA_real_,
+ dim = c(5, 12),
+ dimnames = list(
+ c(
+ "SkyCoverPCT", "WindSpeed_m/s", "HumidityPCT", "SnowDensity_kg/m^3",
+ "RainEvents_per_day"
+ ),
+ c(
+ "January", "February", "March", "April", "May", "June",
+ "July", "August", "September", "October", "November", "December"
+ )
+ )
+ )
+ )
+)
-swCloud_validity <- function(object) {
- val <- TRUE
- temp <- dim(object@Cloud)
+setValidity(
+ "swCloud",
+ function(object) {
+ val <- TRUE
+ temp <- dim(object@Cloud)
- if (temp[1] != 5) {
- msg <- paste(
- "@Cloud must have exactly 5 rows corresponding to",
- "SkyCoverPCT, WindSpeed_m/s, HumidityPCT,",
- "SnowDensity_kg/m^3, and RainEvents_per_day"
- )
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (temp[1] != 5) {
+ msg <- paste(
+ "@Cloud must have exactly 5 rows corresponding to",
+ "SkyCoverPCT, WindSpeed_m/s, HumidityPCT,",
+ "SnowDensity_kg/m^3, and RainEvents_per_day"
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (temp[2] != 12) {
- msg <- paste("@Cloud must have exactly 12 columns corresponding months.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (temp[2] != 12) {
+ msg <- "@Cloud must have exactly 12 columns corresponding months."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(is.na(object@Cloud[1, ])) && (any(object@Cloud[1, ] < 0) ||
- any(object@Cloud[1, ] > 100))) {
- msg <- paste("@Cloud['SkyCoverPCT', ] must be values between 0 and 100%.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (!all(is.na(object@Cloud[1, ])) && (any(object@Cloud[1, ] < 0) ||
+ any(object@Cloud[1, ] > 100))) {
+ msg <- "@Cloud['SkyCoverPCT', ] must be values between 0 and 100%."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(is.na(object@Cloud[2, ])) && (any(object@Cloud[2, ] < 0))) {
- msg <- paste("@Cloud['WindSpeed_m/s', ] must be values >= 0.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (!all(is.na(object@Cloud[2, ])) && (any(object@Cloud[2, ] < 0))) {
+ msg <- "@Cloud['WindSpeed_m/s', ] must be values >= 0."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(is.na(object@Cloud[3, ])) && (any(object@Cloud[3, ] < 0) ||
- any(object@Cloud[3, ] > 100))) {
- msg <- paste("@Cloud['HumidityPCT', ] must be values between 0 and 100%.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (!all(is.na(object@Cloud[3, ])) && (any(object@Cloud[3, ] < 0) ||
+ any(object@Cloud[3, ] > 100))) {
+ msg <- "@Cloud['HumidityPCT', ] must be values between 0 and 100%."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(is.na(object@Cloud[4, ])) && any(object@Cloud[4, ] < 0)) {
- msg <- paste("@Cloud['SnowDensity_kg/m^3', ] must be values >= 0.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (!all(is.na(object@Cloud[4, ])) && any(object@Cloud[4, ] < 0)) {
+ msg <- "@Cloud['SnowDensity_kg/m^3', ] must be values >= 0."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(is.na(object@Cloud[5, ])) && any(object@Cloud[5, ] < 1)) {
- msg <- paste("@Cloud['RainEvents_per_day', ] must be values >= 1.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (!all(is.na(object@Cloud[5, ])) && any(object@Cloud[5, ] < 1)) {
+ msg <- "@Cloud['RainEvents_per_day', ] must be values >= 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- val
-}
-setValidity("swCloud", swCloud_validity)
+ val
+ }
+)
#' @rdname swCloud-class
#' @export
-setMethod("initialize", signature = "swCloud", function(.Object, ...) {
+swCloud <- function(...) {
+ # Copy from SOILWAT2 "testing", but dot arguments take precedence
def <- slot(rSOILWAT2::sw_exampleData, "cloud")
- sns <- slotNames(def)
+ sns <- slotNames("swCloud")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swCloud")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
# 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 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 {
- # Guarantee dimnames
+ # Guarantee names
dimnames(dots[["Cloud"]]) <- dimnames(def@Cloud)
}
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
-
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
-
- validObject(.Object)
- .Object
-})
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+ do.call("new", args = c("swCloud", tmp))
+}
#' @rdname swCloud-class
@@ -156,58 +184,85 @@ setMethod("swCloud_RainEvents", "swCloud", function(object) object@Cloud[5, ])
#' @rdname swCloud-class
#' @export
-setReplaceMethod("set_swCloud", signature = "swCloud", function(object, value) {
- dimnames(value@Cloud) <- dimnames(object@Cloud)
- object <- value
- validObject(object)
- object
-})
+setReplaceMethod(
+ "set_swCloud",
+ signature = "swCloud",
+ function(object, value) {
+ dimnames(value@Cloud) <- dimnames(object@Cloud)
+ object <- value
+ validObject(object)
+ object
+ }
+)
+
#' @rdname swCloud-class
#' @export
-setReplaceMethod("swCloud_SkyCover", signature = "swCloud",
+setReplaceMethod(
+ "swCloud_SkyCover",
+ signature = "swCloud",
function(object, value) {
object@Cloud[1, ] <- value
validObject(object)
object
-})
+ }
+)
+
#' @rdname swCloud-class
#' @export
-setReplaceMethod("swCloud_WindSpeed", signature = "swCloud",
+setReplaceMethod(
+ "swCloud_WindSpeed",
+ signature = "swCloud",
function(object, value) {
object@Cloud[2, ] <- value
validObject(object)
object
-})
+ }
+)
+
#' @rdname swCloud-class
#' @export
-setReplaceMethod("swCloud_Humidity", signature = "swCloud",
+setReplaceMethod(
+ "swCloud_Humidity",
+ signature = "swCloud",
function(object, value) {
object@Cloud[3, ] <- value
validObject(object)
object
-})
+ }
+)
+
#' @rdname swCloud-class
#' @export
-setReplaceMethod("swCloud_SnowDensity", signature = "swCloud",
+setReplaceMethod(
+ "swCloud_SnowDensity",
+ signature = "swCloud",
function(object, value) {
object@Cloud[4, ] <- value
validObject(object)
object
-})
+ }
+)
+
#' @rdname swCloud-class
#' @export
-setReplaceMethod("swCloud_RainEvents", signature = "swCloud",
+setReplaceMethod(
+ "swCloud_RainEvents",
+ signature = "swCloud",
function(object, value) {
object@Cloud[5, ] <- value
validObject(object)
object
-})
-
+ }
+)
#' @rdname swCloud-class
#' @export
-setMethod("swReadLines", signature = c(object = "swCloud", file = "character"),
+# nolint start
+setMethod(
+ "swReadLines",
+ signature = c(object = "swCloud", file = "character"),
function(object, file) {
+ stop("swReadLines is defunct")
infiletext <- readLines(con = file)
#should be no empty lines
infiletext <- infiletext[infiletext != ""]
@@ -225,3 +280,4 @@ setMethod("swReadLines", signature = c(object = "swCloud", file = "character"),
object
})
+# nolint end
diff --git a/R/D_swMarkov.R b/R/D_swMarkov.R
index ce73bf28..9efefdba 100644
--- a/R/D_swMarkov.R
+++ b/R/D_swMarkov.R
@@ -29,10 +29,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swMarkov}}.
-#' @param .Object An object of class \code{\linkS4class{swMarkov}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -44,16 +50,48 @@
#' @examples
#' showClass("swMarkov")
#' x <- new("swMarkov")
+#' x <- swMarkov()
#'
#' @name swMarkov-class
#' @export
-setClass("swMarkov", slots = c(Prob = "matrix", Conv = "matrix"))
+setClass(
+ "swMarkov",
+ slots = c(Prob = "matrix", Conv = "matrix"),
+ prototype = list(
+ Prob = array(
+ NA_real_,
+ dim = c(366, 5),
+ dimnames = list(
+ NULL,
+ c("DOY", "p_wet_wet", "p_wet_dry", "avg_ppt", "std_ppt")
+ )
+ ),
+ Conv = array(
+ NA_real_,
+ dim = c(53, 11),
+ dimnames = list(
+ NULL,
+ c(
+ "WEEK", "wTmax_C", "wTmin_C", "var_wTmax", "cov_wTmaxmin",
+ "cov_wTminmax", "var_wTmin", "cfmax_wet", "cfmax_dry", "cfmin_wet",
+ "cfmin_dry"
+ )
+ )
+ )
+ )
+)
#' @rdname swMarkov-class
#' @export
-setMethod("initialize", signature = "swMarkov", function(.Object, ...) {
+swMarkov <- function(...) {
+ # Copy from SOILWAT2 "testing", but dot arguments take precedence
def <- slot(rSOILWAT2::sw_exampleData, "markov")
+ sns <- slotNames("swMarkov")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swMarkov")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
# We don't set values for slots `Prob` and `Conv`; this is to prevent
@@ -62,69 +100,89 @@ setMethod("initialize", signature = "swMarkov", function(.Object, ...) {
# We have to explicitly give column names (as defined in `onGet_MKV_prob` and
# `onGet_MKV_conv`) because they are not read in by C code if the weather
# generator is turned off
- ctemp_Prob <- c("DOY", "p_wet_wet", "p_wet_dry", "avg_ppt", "std_ppt")
- ctemp_Conv <- c("WEEK", "wTmax_C", "wTmin_C", "var_wTmax",
- "cov_wTmaxmin", "cov_wTminmax", "var_wTmin",
- "cfmax_wet", "cfmax_dry", "cfmin_wet", "cfmin_dry")
+ tmp <- new("swMarkov")
+ ctemp_Prob <- colnames(slot(tmp, "Prob"))
+ ctemp_Conv <- colnames(slot(tmp, "Conv"))
if ("Prob" %in% dns) {
- temp <- dots[["Prob"]]
- if (sum(dim(temp)) > 0) {
- colnames(temp) <- ctemp_Prob
+ tmp <- dots[["Prob"]]
+ if (sum(dim(tmp)) > 0) {
+ colnames(tmp) <- ctemp_Prob
}
} else {
- temp <- matrix(NA_real_, nrow = 366, ncol = length(ctemp_Prob),
- dimnames = list(NULL, ctemp_Prob))
- temp[, "DOY"] <- 1:366
+ tmp <- array(
+ NA_real_,
+ dim = c(366, length(ctemp_Prob)),
+ dimnames = list(NULL, ctemp_Prob)
+ )
+ tmp[, "DOY"] <- 1:366
}
- .Object@Prob <- temp
+ dots[["Prob"]] <- tmp
if ("Conv" %in% dns) {
- temp <- dots[["Conv"]]
- if (sum(dim(temp)) > 0) {
- colnames(temp) <- ctemp_Conv
+ tmp <- dots[["Conv"]]
+ if (sum(dim(tmp)) > 0) {
+ colnames(tmp) <- ctemp_Conv
}
} else {
- temp <- matrix(NA_real_, nrow = 53, ncol = length(ctemp_Conv),
- dimnames = list(NULL, ctemp_Conv))
- temp[, "WEEK"] <- 1:53
+ tmp <- array(
+ NA_real_,
+ dim = c(53, length(ctemp_Conv)),
+ dimnames = list(NULL, ctemp_Conv)
+ )
+ tmp[, "WEEK"] <- 1:53
}
- .Object@Conv <- temp
+ dots[["Conv"]] <- tmp
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- validObject(.Object)
- .Object
-})
+ do.call("new", args = c("swMarkov", tmp))
+}
-swMarkov_validity <- function(object) {
- val <- TRUE
- temp <- dim(object@Prob)
- if (!isTRUE(all.equal(temp, c(0, 0))) &&
- !isTRUE(all.equal(temp, c(366, 5)))) {
- msg <- paste("@Prob must be a 0x0 or a 366x5 matrix.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- temp <- dim(object@Conv)
- if (!isTRUE(all.equal(temp, c(0, 0))) &&
- !isTRUE(all.equal(temp, c(53, 11)))) {
- msg <- paste("@Conv must be a 0x0 or a 53x11 matrix.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+setValidity(
+ "swMarkov",
+ function(object) {
+ val <- TRUE
- val
-}
-setValidity("swMarkov", swMarkov_validity)
+ temp <- dim(object@Prob)
+ if (
+ !isTRUE(all.equal(temp, c(0, 0))) &&
+ !isTRUE(all.equal(temp, c(366, 5)))
+ ) {
+ msg <- "@Prob must be a 0x0 or a 366x5 matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ temp <- dim(object@Conv)
+ if (
+ !isTRUE(all.equal(temp, c(0, 0))) &&
+ !isTRUE(all.equal(temp, c(53, 11)))
+ ) {
+ msg <- "@Conv must be a 0x0 or a 53x11 matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ val
+ }
+)
+
+# use `get_swMarkov()`; `get_Markov()` is a legacy name
#' @rdname swMarkov-class
#' @export
setMethod("get_Markov", "swMarkov", function(object) object)
+
+#' @rdname swMarkov-class
+#' @export
+setMethod("get_swMarkov", "swMarkov", function(object) object)
+
#' @rdname swMarkov-class
#' @export
setMethod("swMarkov_Prob", "swMarkov", function(object) object@Prob)
@@ -132,23 +190,39 @@ setMethod("swMarkov_Prob", "swMarkov", function(object) object@Prob)
#' @export
setMethod("swMarkov_Conv", "swMarkov", function(object) object@Conv)
+# use `set_swMarkov()`; `set_Markov()` is a legacy name
#' @rdname swMarkov-class
#' @export
-setReplaceMethod("set_Markov", signature = "swMarkov", function(object, value) {
- if (ncol(value@Prod) == ncol(object@Prob)) {
- dimnames(value@Prob) <- dimnames(object@Prob)
+setReplaceMethod(
+ "set_Markov",
+ signature = "swMarkov", function(object, value) {
+ set_swMarkov(object) <- value
+ object
}
- if (ncol(value@Conv) == ncol(object@Conv)) {
- dimnames(value@Conv) <- dimnames(object@Conv)
+)
+
+#' @rdname swMarkov-class
+#' @export
+setReplaceMethod(
+ "set_swMarkov",
+ signature = "swMarkov", function(object, value) {
+ if (ncol(value@Prod) == ncol(object@Prob)) {
+ dimnames(value@Prob) <- dimnames(object@Prob)
+ }
+ if (ncol(value@Conv) == ncol(object@Conv)) {
+ dimnames(value@Conv) <- dimnames(object@Conv)
+ }
+ object <- value
+ validObject(object)
+ object
}
- object <- value
- validObject(object)
- object
-})
+)
#' @rdname swMarkov-class
#' @export
-setReplaceMethod("swMarkov_Prob", signature = "swMarkov",
+setReplaceMethod(
+ "swMarkov_Prob",
+ signature = "swMarkov",
function(object, value) {
if (ncol(value) == ncol(object@Prob)) {
colnames(value) <- dimnames(object@Prob)[[2]]
@@ -156,11 +230,14 @@ setReplaceMethod("swMarkov_Prob", signature = "swMarkov",
object@Prob <- as.matrix(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swMarkov-class
#' @export
-setReplaceMethod("swMarkov_Conv", signature = "swMarkov",
+setReplaceMethod(
+ "swMarkov_Conv",
+ signature = "swMarkov",
function(object, value) {
if (ncol(value) == ncol(object@Conv)) {
colnames(value) <- dimnames(object@Conv)[[2]]
@@ -168,13 +245,18 @@ setReplaceMethod("swMarkov_Conv", signature = "swMarkov",
object@Conv <- as.matrix(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swMarkov-class
#' @export
-setMethod("swReadLines", signature = c(object = "swMarkov", file = "character"),
+# nolint start
+setMethod(
+ "swReadLines",
+ signature = c(object = "swMarkov", file = "character"),
function(object, file) {
+ stop("swReadLines is defunct")
id_skip <- 1:2
infiletext <- readLines(con = file[1])
@@ -198,4 +280,6 @@ setMethod("swReadLines", signature = c(object = "swMarkov", file = "character"),
}
object
-})
+ }
+)
+# nolint end
diff --git a/R/D_swWeather.R b/R/D_swWeather.R
index ac68afaf..dee9b45b 100644
--- a/R/D_swWeather.R
+++ b/R/D_swWeather.R
@@ -28,9 +28,14 @@
#' The methods listed below work on this class and the proper slot of the class
#' \code{\linkS4class{swInputData}}.
#'
-#' @param .Object An object of class
-#' \code{\linkS4class{swMonthlyScalingParams}}.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -42,56 +47,124 @@
#' @examples
#' showClass("swMonthlyScalingParams")
#' x <- new("swMonthlyScalingParams")
+#' x <- swMonthlyScalingParams()
#'
#' @name swMonthlyScalingParams-class
#' @export
-setClass("swMonthlyScalingParams", slots = c(MonthlyScalingParams = "matrix"))
+setClass(
+ "swMonthlyScalingParams",
+ slots = c(MonthlyScalingParams = "matrix"),
+ prototype = list(
+ MonthlyScalingParams = array(
+ NA_real_,
+ dim = c(12, 8),
+ dimnames = list(
+ NULL,
+ c("PPT", "MaxT", "MinT", "SkyCover", "Wind", "rH", "ActVP", "ShortWR")
+ )
+ )
+ )
+)
+
+setValidity(
+ "swMonthlyScalingParams",
+ function(object) {
+ val <- TRUE
+ temp <- dim(object@MonthlyScalingParams)
+
+ if (temp[2] != 8) {
+ msg <- paste(
+ "@MonthlyScalingParams must have exactly 8 columns ",
+ "corresponding to PPT, MaxT, MinT, SkyCover, Wind, rH, ActVP, ShortWR"
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (temp[1] != 12) {
+ msg <- paste(
+ "@MonthlyScalingParams must have exactly 12 rows",
+ "corresponding months."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
-setValidity("swMonthlyScalingParams", function(object) {
- val <- TRUE
- temp <- dim(object@MonthlyScalingParams)
+ val
+ }
+)
- if (temp[2] != 6) {
- msg <- paste("@MonthlyScalingParams must have exactly 6 columns ",
- "corresponding to PPT, MaxT, MinT, SkyCover, Wind, rH")
- val <- if (isTRUE(val)) msg else c(val, msg)
+#' @rdname swMonthlyScalingParams-class
+#' @export
+swMonthlyScalingParams <- function(...) {
+ def <- slot(rSOILWAT2::sw_exampleData, "weather")
+ sns <- slotNames("swMonthlyScalingParams")
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swMonthlyScalingParams")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
}
- if (temp[1] != 12) {
- msg <- paste("@MonthlyScalingParams must have exactly 12 rows",
- "corresponding months.")
- val <- if (isTRUE(val)) msg else c(val, msg)
+ dns <- names(dots)
+
+ if ("MonthlyScalingParams" %in% dns) {
+ # Guarantee names
+ dimnames(dots[["MonthlyScalingParams"]]) <- dimnames(
+ def@MonthlyScalingParams
+ )
}
- val
-})
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call("new", args = c("swMonthlyScalingParams", tmp))
+}
+
+sw_upgrade_MonthlyScalingParams <- function( # nolint: object_length_linter.
+ MonthlyScalingParams,
+ verbose = FALSE
+) {
+ if (verbose) {
+ message("Upgrading object `MonthlyScalingParams`.")
+ }
-#' @rdname swMonthlyScalingParams-class
-#' @export
-setMethod("initialize", signature = "swMonthlyScalingParams",
- function(.Object, ...) {
- def <- slot(rSOILWAT2::sw_exampleData, "weather")
- sns <- slotNames("swMonthlyScalingParams")
- dots <- list(...)
- dns <- names(dots)
-
- if ("MonthlyScalingParams" %in% dns) {
- # Guarantee dimnames
- dimnames(dots[["MonthlyScalingParams"]]) <-
- dimnames(def@MonthlyScalingParams)
- }
+ #--- Add new columns (use default values)
+ default <- swMonthlyScalingParams()
+ vars_exp <- colnames(default@MonthlyScalingParams)
+ vars_has <- colnames(MonthlyScalingParams)
+
+ if (!all(vars_exp %in% vars_has)) {
+ res <- default@MonthlyScalingParams
+ res[, vars_has] <- MonthlyScalingParams[, vars_has]
+ res
+ } else {
+ MonthlyScalingParams
+ }
+}
+
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swMonthlyScalingParams",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swMonthlyScalingParams`.")
+ }
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ object@MonthlyScalingParams <- suppressWarnings(
+ sw_upgrade_MonthlyScalingParams(object@MonthlyScalingParams)
+ )
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
+ #--- Check validity and return
+ validObject(object)
}
- validObject(.Object)
- .Object
-})
+ object
+ }
+)
@@ -103,10 +176,16 @@ setMethod("initialize", signature = "swMonthlyScalingParams",
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swWeather}}.
-#' @param .Object An object of class \code{\linkS4class{swWeather}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swInputData}} \code{\linkS4class{swCloud}}
@@ -118,6 +197,7 @@ setMethod("initialize", signature = "swMonthlyScalingParams",
#' @examples
#' showClass("swWeather")
#' x <- new("swWeather")
+#' x <- swWeather()
#'
#' @name swWeather-class
#' @export
@@ -129,142 +209,266 @@ setClass(
pct_SnowRunoff = "numeric",
use_weathergenerator = "logical",
use_weathergenerator_only = "logical",
- FirstYear_Historical = "integer"
+ FirstYear_Historical = "integer",
+ use_cloudCoverMonthly = "logical",
+ use_windSpeedMonthly = "logical",
+ use_humidityMonthly = "logical",
+ desc_rsds = "integer",
+ dailyInputFlags = "logical"
),
- contains = "swMonthlyScalingParams"
+ # TODO: this class should not contain `swMonthlyScalingParams` but
+ # instead be a composition, i.e., have a slot of that class
+ contains = "swMonthlyScalingParams",
+ prototype = list(
+ UseSnow = NA,
+ pct_SnowDrift = NA_real_,
+ pct_SnowRunoff = NA_real_,
+ use_weathergenerator = NA,
+ use_weathergenerator_only = NA,
+ FirstYear_Historical = NA_integer_,
+ use_cloudCoverMonthly = NA,
+ use_windSpeedMonthly = NA,
+ use_humidityMonthly = NA,
+ desc_rsds = NA_integer_,
+ # NOTE: 14 must be
+ # equal to rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
+ dailyInputFlags = rep(NA, 14L)
+ )
)
-setValidity("swWeather", function(object) {
- val <- TRUE
- sns <- setdiff(slotNames("swWeather"), inheritedSlotNames("swWeather"))
+setValidity(
+ "swWeather",
+ function(object) {
+ val <- TRUE
+ sns <- setdiff(slotNames("swWeather"), inheritedSlotNames("swWeather"))
- for (sn in sns) {
- if (length(slot(object, sn)) != 1) {
- msg <- paste0("@", sn, " must have exactly one value.")
- val <- if (isTRUE(val)) msg else c(val, msg)
+ for (sn in sns) {
+ n_exp <- if (sn %in% "dailyInputFlags") {
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
+ } else {
+ 1L
+ }
+
+ n_has <- length(slot(object, sn))
+
+ if (n_has != n_exp) {
+ msg <- paste0(
+ "@", sn, " has n = ", n_has, " instead of n = ", n_exp, " value(s)."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
}
- }
- val
-})
+ val
+ }
+)
#' @rdname swWeather-class
#' @export
-setMethod("initialize", signature = "swWeather", function(.Object, ...) {
+swWeather <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "weather")
sns <- setdiff(slotNames("swWeather"), inheritedSlotNames("swWeather"))
dots <- list(...)
- dns <- names(dots)
-
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) {
- dots[[sn]]
- } else {
- if (sn == "FirstYear_Historical") {
- -1L
+ if (length(dots) == 1 && inherits(dots[[1]], "swWeather")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
+ dns <- setdiff(names(dots), inheritedSlotNames("swWeather"))
+
+ # Fix "FirstYear_Historical"
+ def@FirstYear_Historical <- -1L
+
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call(
+ "new",
+ args = c(
+ "swWeather",
+ if ("MonthlyScalingParams" %in% dns) {
+ swMonthlyScalingParams(dots[["MonthlyScalingParams"]])
} else {
- slot(def, sn)
+ do.call(swMonthlyScalingParams, dots)
+ },
+ tmp
+ )
+ )
+}
+
+
+
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swWeather",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ # Upgrade `MonthlyScalingParams` with dedicated upgrade method first;
+ # `swMonthlyScalingParams()` via `swWeather()` cannot handle
+ # an increased number of columns in `MonthlyScalingParams` otherwise
+ object@MonthlyScalingParams <- suppressWarnings(
+ sw_upgrade_MonthlyScalingParams(
+ object@MonthlyScalingParams,
+ verbose = verbose
+ )
+ )
+
+ if (verbose) {
+ message("Upgrading object of class `swWeather`.")
}
+ object <- suppressWarnings(swWeather(object))
}
- }
-
- .Object <- callNextMethod(.Object, ...)
- validObject(.Object)
-
- .Object
-})
+ object
+ }
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_DaysRunningAverage", "swWeather",
- function(object) object@DaysRunningAverage)
+setMethod(
+ "swWeather_DaysRunningAverage",
+ "swWeather",
+ function(object) object@DaysRunningAverage
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_FirstYearHistorical", "swWeather",
- function(object) object@FirstYear_Historical)
+setMethod(
+ "swWeather_FirstYearHistorical",
+ "swWeather",
+ function(object) {
+ .Deprecated() # `FirstYear_Historical` is no longer used by SOILWAT2.
+ object@FirstYear_Historical
+ }
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_pct_SnowDrift", "swWeather",
- function(object) object@pct_SnowDrift)
+setMethod(
+ "swWeather_pct_SnowDrift",
+ "swWeather",
+ function(object) object@pct_SnowDrift
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_pct_SnowRunoff", "swWeather",
- function(object) object@pct_SnowRunoff)
+setMethod(
+ "swWeather_pct_SnowRunoff",
+ "swWeather",
+ function(object) object@pct_SnowRunoff
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_UseMarkov", "swWeather",
- function(object) object@use_weathergenerator)
+setMethod(
+ "swWeather_UseMarkov",
+ "swWeather",
+ function(object) object@use_weathergenerator
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_UseMarkovOnly", "swWeather",
- function(object) object@use_weathergenerator_only)
+setMethod(
+ "swWeather_UseMarkovOnly",
+ "swWeather",
+ function(object) object@use_weathergenerator_only
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_UseSnow", "swWeather",
- function(object) object@UseSnow)
+setMethod(
+ "swWeather_UseSnow",
+ "swWeather",
+ function(object) object@UseSnow
+)
#' @rdname swWeather-class
#' @export
-setMethod("swWeather_MonScalingParams", "swWeather",
- function(object) object@MonthlyScalingParams)
+setMethod(
+ "swWeather_MonScalingParams",
+ "swWeather",
+ function(object) object@MonthlyScalingParams
+)
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_DaysRunningAverage", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_DaysRunningAverage",
+ signature = "swWeather",
function(object, value) {
object@DaysRunningAverage <- as.integer(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_FirstYearHistorical", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_FirstYearHistorical",
+ signature = "swWeather",
function(object, value) {
+ .Deprecated() # `FirstYear_Historical` is no longer used by SOILWAT2.
object@FirstYear_Historical <- as.integer(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_pct_SnowDrift", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_pct_SnowDrift",
+ signature = "swWeather",
function(object, value) {
object@pct_SnowDrift <- as.numeric(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_pct_SnowRunoff", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_pct_SnowRunoff",
+ signature = "swWeather",
function(object, value) {
object@pct_SnowRunoff <- as.numeric(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_UseMarkov", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_UseMarkov",
+ signature = "swWeather",
function(object, value) {
object@use_weathergenerator <- as.logical(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_UseMarkovOnly", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_UseMarkovOnly",
+ signature = "swWeather",
function(object, value) {
object@use_weathergenerator_only <- as.logical(value)
if (object@use_weathergenerator_only) {
@@ -272,32 +476,42 @@ setReplaceMethod("swWeather_UseMarkovOnly", signature = "swWeather",
}
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_UseSnow", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_UseSnow",
+ signature = "swWeather",
function(object, value) {
object@UseSnow <- as.logical(value)
validObject(object)
object
-})
+ }
+)
+
#' @rdname swWeather-class
#' @export
-setReplaceMethod("swWeather_MonScalingParams", signature = "swWeather",
+setReplaceMethod(
+ "swWeather_MonScalingParams",
+ signature = "swWeather",
function(object, value) {
object@MonthlyScalingParams[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swWeather-class
#' @export
# nolint start
-setMethod("swReadLines",
+setMethod(
+ "swReadLines",
signature = c(object = "swWeather", file = "character"),
function(object, file) {
print(paste(
@@ -311,17 +525,26 @@ setMethod("swReadLines",
object@pct_SnowRunoff <- readNumeric(infiletext[6])
object@use_weathergenerator <- readLogical(infiletext[7])
object@FirstYear_Historical <- readInteger(infiletext[8])
+ object@use_cloudCoverMonthly <- readLogical(infiletext[9])
+ object@use_windSpeedMonthly <- readLogical(infiletext[10])
+ object@use_relHumidityMonthly <- readLogical(infiletext[11])
+ object@desc_rsds <- readLogical(infiletext[12])
+
+ for (i in seq_len(14)) {
+ object@dailyInputFlags[i] <- readLogical(infiletext[12 + 1])
+ }
- data <- matrix(data = c(rep(1, 12), rep(NA, 12 * 5)), nrow = 12, ncol = 6)
- colnames(data) <- c("PPT", "MaxT", "MinT", "SkyCover", "Wind", "rH")
+ data <- matrix(data = c(rep(1, 12), rep(NA, 12 * 5)), nrow = 12, ncol = 8)
+ colnames(data) <- c("PPT", "MaxT", "MinT", "SkyCover", "Wind", "rH", "actVP", "shortWR")
rownames(data) <- c("January", "February", "March", "April", "May",
"June", "July", "August", "September", "October", "November", "December")
- for (i in 21:32) {
- data[i - 20, ] <- readNumerics(infiletext[i], 8)[2:8]
+ for (i in 1:12) {
+ data[i, ] <- readNumerics(infiletext[12 + 14 + i], 8)[2:8]
}
object@MonthlyScalingParams <- data
object
-})
+ }
+)
# nolint end
diff --git a/R/D_swWeatherData.R b/R/D_swWeatherData.R
index 76256ef1..7547388e 100644
--- a/R/D_swWeatherData.R
+++ b/R/D_swWeatherData.R
@@ -23,20 +23,75 @@
##############################################################################
+
+#' List names of currently implemented daily weather variables
+#' @return A vector of daily weather variable names.
+#' @export
+weather_dataColumns <- function() {
+ c(
+ "Tmax_C", "Tmin_C", "PPT_cm",
+ "cloudCov_pct",
+ "windSpeed_mPERs", "windSpeed_east_mPERs", "windSpeed_north_mPERs",
+ "rHavg_pct", "rHmax_pct", "rHmin_pct", "specHavg_pct", "Tdewpoint_C",
+ "actVP_kPa",
+ "shortWR"
+ )
+}
+
+#' Functions to summarize currently implemented daily weather variables
+#' @return A named vector of functions that summarize
+#' daily weather variables across time.
+#' @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
+ )
+}
+
#' Class \code{"swWeatherData"}
#'
#' The methods listed below work on this class and the proper slot of the class
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swWeatherData}}.
-#' @param .Object An object of class \code{\linkS4class{swWeatherData}}.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
-#' @param year An integer value. The calendar year of the weather \code{data}
+#' @param weatherList A list or \code{NULL}. Each element is an object of class
+#' \code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}}
+#' containing daily weather data of a specific year.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
+#' @slot year An integer value. The calendar year of the weather \code{data}
#' object.
-#' @param data A 365 x 4 or 366 x 4 matrix representing daily weather data for
-#' one calendar \code{year} with columns \var{DOY}, \var{Tmax_C},
-#' \var{Tmin_C}, and \var{PPT_cm}.
+#' @slot data A 365 x 15 or 366 x 15 matrix representing daily weather data for
+#' one calendar \code{year} with columns
+#' \var{DOY},
+#' \var{Tmax_C}, \var{Tmin_C}, \var{PPT_cm},
+#' \var{cloudCov_pct},
+#' \var{windSpeed_mPERs},
+#' \var{windSpeed_east_mPERs}, \var{windSpeed_north_mPERs},
+#' \var{rHavg_pct}, \var{rHmax_pct}, \var{rHmin_pct},
+#' \var{specHavg_pct}, \var{Tdewpoint_C},
+#' \var{actVP_kPa}, and
+#' \var{shortWR}.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -48,75 +103,157 @@
#' @examples
#' showClass("swWeatherData")
#' x <- new("swWeatherData")
+#' x <- swWeatherData()
#'
#' @name swWeatherData-class
#' @export
-setClass("swWeatherData", slots = c(data = "matrix", year = "integer"))
+setClass(
+ "swWeatherData",
+ slots = c(data = "matrix", year = "integer"),
+ prototype = list(
+ # NOTE: 999 should be rSW2_glovars[["kSOILWAT2"]][["kNUM"]][["SW_MISSING"]]
+ # NOTE: 15 must be
+ # equal to 1 + rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
+ data = array(
+ data = c(1:366, rep(NA, 366 * 15L)),
+ dim = c(366, 15L),
+ dimnames = list(
+ NULL,
+ c("DOY", weather_dataColumns())
+ )
+ ),
+ year = NA_integer_
+ )
+)
-swWeatherData_validity <- function(object) {
- val <- TRUE
+setValidity(
+ "swWeatherData",
+ function(object) {
+ val <- TRUE
+ ref <- new("swWeatherData")
- if (!(length(object@year) == 1 && isTRUE(is.finite(object@year)) &&
- isTRUE(object@year >= 0))) {
- msg <- "@year must be exactly one positive finite value."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ if (
+ !(
+ length(object@year) == 1 &&
+ (
+ isTRUE(is.finite(object@year) && object@year >= 0) ||
+ isTRUE(is.na(object@year))
+ )
+ )
+ ) {
+ msg <- "@year must be exactly one positive value or NA."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ tmp <- dim(object@data)
+ if (tmp[2] != ncol(ref@data)) {
+ msg <- paste(
+ "@data must have exactly", ncol(ref@data), "columns corresponding to",
+ toString(colnames(ref@data))
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (!(tmp[1] %in% c(365, 366))) {
+ msg <- "@data must 365 or 366 rows corresponding to day of year."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ val
}
+)
- temp <- dim(object@data)
- if (temp[2] != 4) {
- msg <- paste("@data must have exactly 4 columns corresponding to",
- "DOY, Tmax_C, Tmin_C, PPT_cm")
- val <- if (isTRUE(val)) msg else c(val, msg)
+#' @rdname swWeatherData-class
+#' @export
+swWeatherData <- function(...) {
+ # We don't use default values for slots `year` and `data`; this is to prevent
+ # simulation runs with accidentally incorrect values
+ def <- new("swWeatherData")
+ sns <- slotNames(def)
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swWeatherData")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
}
- if (!(temp[1] %in% c(365, 366))) {
- msg <- paste("@data must 365 or 366 rows corresponding to day of year.")
- val <- if (isTRUE(val)) msg else c(val, msg)
+ dns <- names(dots)
+
+ # Guarantee names
+ if ("data" %in% dns) {
+ dimnames(dots[["data"]]) <- dimnames(slot(def, "data"))
}
- val
+ if ("year" %in% dns) {
+ dots[["year"]] <- as.integer(dots[["year"]])
+ }
+
+ do.call("new", args = c("swWeatherData", dots[dns %in% sns]))
}
-setValidity("swWeatherData", swWeatherData_validity)
-#' @rdname swWeatherData-class
+
+#' @rdname sw_upgrade
#' @export
-setMethod("initialize", signature = "swWeatherData", function(.Object, ...,
- year = 0L, data = NULL) {
+upgrade_weatherHistory <- function(object, verbose = FALSE) {
+ tmp <- try(dbW_check_weatherData(object, check_all = FALSE), silent = TRUE)
+ if (inherits(tmp, "try-error") || !isTRUE(tmp)) {
+ if (verbose) {
+ message("Upgrading `weatherHistory` object.")
+ }
- # first year of weather data
- def <- slot(rSOILWAT2::sw_exampleData, "weatherHistory")[[1]]
- # We don't set values for slots `year` and `data`; this is to prevent
- # simulation runs with accidentally incorrect values
+ ref <- new("swWeatherData")
- if (is.null(data)) {
- temp <- c(1:366,
- rep(rSW2_glovars[["kSOILWAT2"]][["kNUM"]][["SW_MISSING"]], 366 * 3))
- data <- matrix(temp, nrow = 366, ncol = 4)
+ object <- lapply(
+ object,
+ function(old) {
+ new <- ref
+ new@year <- old@year
+ new@data <- new@data[seq_len(nrow(old@data)), , drop = FALSE]
+ new@data[, colnames(old@data)] <- old@data
+ new
+ }
+ )
}
- colnames(data) <- colnames(slot(def, "data"))
- .Object@data <- data
- .Object@year <- as.integer(year)
+ object
+}
+
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
+#' @rdname swWeatherData-class
+#' @export
+weatherHistory <- function(weatherList = NULL) {
+ if (isTRUE(dbW_check_weatherData(weatherList))) {
+ weatherList
+ } else {
+ list(swWeatherData())
}
+}
- validObject(.Object)
- .Object
-})
#' @rdname swWeatherData-class
#' @export
-setMethod("swReadLines",
+setMethod(
+ "swReadLines",
signature = c(object = "swWeatherData", file = "character"),
function(object, file) {
- object@year <- as.integer(strsplit(x = basename(file), split = ".",
- fixed = TRUE)[[1]][2])
- data <- utils::read.table(file, header = FALSE, comment.char = "#",
- blank.lines.skip = TRUE, sep = "\t")
+ .Deprecated("C_rSW2_readAllWeatherFromDisk")
+ warning("swReadLines works only with traditional weather data.")
+
+ object@year <- as.integer(
+ strsplit(
+ x = basename(file),
+ split = ".",
+ fixed = TRUE
+ )[[1]][2]
+ )
+ data <- utils::read.table(
+ file,
+ header = FALSE,
+ comment.char = "#",
+ blank.lines.skip = TRUE,
+ sep = "\t"
+ )
+ stopifnot(ncol(data) != 4L)
colnames(data) <- c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
- object@data <- as.matrix(data)
+ object@data[] <- NA
+ object@data[, colnames(data)] <- as.matrix(data)
object
})
diff --git a/R/E_swProd.R b/R/E_swProd.R
index a7231ec9..343a9cbc 100644
--- a/R/E_swProd.R
+++ b/R/E_swProd.R
@@ -22,6 +22,8 @@
# Zach Kramer (2017)
###############################################################################
+veg_names <- c("Grasses", "Shrubs", "Trees", "Forbs")
+lc_names <- c(veg_names, "Bare Ground")
#' Class \code{"swProd"}
#'
@@ -29,10 +31,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swProd}}.
-#' @param .Object An object of class \code{\linkS4class{swProd}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#' @param vegtype The name or index of the vegetation type.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
@@ -45,114 +53,238 @@
#' @examples
#' showClass("swProd")
#' x <- new("swProd")
+#' x <- swProd()
#'
#' @name swProd-class
#' @export
-setClass("swProd", slots = c(Composition = "numeric", Albedo = "numeric",
- CanopyHeight = "matrix",
- VegetationInterceptionParameters = "matrix",
- LitterInterceptionParameters = "matrix",
- EsTpartitioning_param = "numeric", Es_param_limit = "numeric",
- Shade = "matrix",
- HydraulicRedistribution_use = "logical", HydraulicRedistribution = "matrix",
- CriticalSoilWaterPotential = "numeric", CO2Coefficients = "matrix",
- MonthlyVeg = "list"))
-
-
-swProd_validity <- function(object) {
- val <- TRUE
- nvegs <- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["NVEGTYPES"]]
-
- if (length(object@Composition) != 1 + nvegs ||
- !all(is.na(object@Composition) | (object@Composition >= 0 &
- object@Composition <= 1))) {
- msg <- "@Composition must have 1 + NVEGTYPES values between 0 and 1 or NA."
+setClass(
+ "swProd",
+ slots = c(
+ veg_method = "integer",
+ Composition = "numeric",
+ Albedo = "numeric",
+ CanopyHeight = "matrix",
+ VegetationInterceptionParameters = "matrix",
+ LitterInterceptionParameters = "matrix",
+ EsTpartitioning_param = "numeric",
+ Es_param_limit = "numeric",
+ Shade = "matrix",
+ HydraulicRedistribution_use = "logical",
+ HydraulicRedistribution = "matrix",
+ CriticalSoilWaterPotential = "numeric",
+ CO2Coefficients = "matrix",
+ MonthlyVeg = "list"
+ ),
+ prototype = list(
+ veg_method = NA_integer_,
+ # this should be 1 + rSW2_glovars[["kSOILWAT2"]][["kINT"]][["NVEGTYPES"]]
+ Composition = stats::setNames(rep(NA_real_, 5), lc_names),
+ Albedo = stats::setNames(rep(NA_real_, 5), lc_names),
+ CanopyHeight = array(
+ NA_real_,
+ dim = c(5L, 4L),
+ dimnames = list(
+ c("xinflec", "yinflec", "range", "slope", "height_cm"),
+ veg_names
+ )
+ ),
+ VegetationInterceptionParameters = array(
+ NA_real_,
+ dim = c(2L, 4L),
+ dimnames = list(
+ c("kSmax", "kdead"),
+ veg_names
+ )
+ ),
+ LitterInterceptionParameters = array(
+ NA_real_,
+ dim = c(1L, 4L),
+ dimnames = list(
+ "kSmax",
+ veg_names
+ )
+ ),
+ EsTpartitioning_param = stats::setNames(rep(NA_real_, 4L), veg_names),
+ Es_param_limit = stats::setNames(rep(NA_real_, 4L), veg_names),
+ Shade = array(
+ NA_real_,
+ dim = c(6L, 4L),
+ dimnames = list(
+ c(
+ "ShadeScale", "ShadeMaximalDeadBiomass", "tanfuncXinflec",
+ "yinflec", "range", "slope"
+ ),
+ veg_names
+ )
+ ),
+ HydraulicRedistribution_use = stats::setNames(rep(NA, 4L), veg_names),
+ HydraulicRedistribution = array(
+ NA_real_,
+ dim = c(3L, 4L),
+ dimnames = list(
+ c("MaxCondRoot", "SoilWaterPotential50", "ShapeCond"),
+ veg_names
+ )
+ ),
+ CriticalSoilWaterPotential = stats::setNames(rep(NA_real_, 4L), veg_names),
+ CO2Coefficients = array(
+ NA_real_,
+ dim = c(4L, 4L),
+ dimnames = list(
+ veg_names,
+ c("Biomass Coeff1", "Biomass Coeff2", "WUE Coeff1", "WUE Coeff2")
+ )
+ ),
+ MonthlyVeg = stats::setNames(
+ lapply(
+ veg_names,
+ function(k) {
+ array(
+ NA_real_,
+ dim = c(12L, 4L),
+ dimnames = list(
+ c(
+ "January", "February", "March", "April", "May", "June",
+ "July", "August", "September", "October", "November", "December"
+ ),
+ c("Litter", "Biomass", "Live_pct", "LAI_conv")
+ )
+ )
+ }
+ ),
+ veg_names
+ )
+ )
+)
+
+
+
+setValidity(
+ "swProd",
+ function(object) {
+ val <- TRUE
+ nvegs <- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["NVEGTYPES"]]
+
+ if (length(object@veg_method) != 1L) {
+ msg <- "@veg_method must have 1 value."
val <- if (isTRUE(val)) msg else c(val, msg)
}
- if (length(object@Albedo) != 1 + nvegs ||
- !all(is.na(object@Albedo) | (object@Albedo >= 0 & object@Albedo <= 1))) {
- msg <- "@Albedo must have 1 + NVEGTYPES values between 0 and 1 or NA."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@CanopyHeight)
- if (identical(temp, c(5, nvegs))) {
- msg <- "@CanopyHeight must be a 5xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@VegetationInterceptionParameters)
- if (identical(temp, c(2, nvegs))) {
- msg <- "@VegetationInterceptionParameters must be a 4xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@LitterInterceptionParameters)
- if (identical(temp, c(1, nvegs))) {
- msg <- "@LitterInterceptionParameters must be a 1xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- if (length(object@EsTpartitioning_param) != nvegs ||
- !all(is.finite(object@EsTpartitioning_param))) {
- msg <- "@EsTpartitioning_param must have NVEGTYPES finite values."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- if (length(object@Es_param_limit) != nvegs ||
- !all(object@Es_param_limit >= 0)) {
- msg <- "@Es_param_limit must have NVEGTYPES non-negative values."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@Shade)
- if (identical(temp, c(6, nvegs))) {
- msg <- "@Shade must be a 6xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- if (length(object@HydraulicRedistribution_use) != nvegs) {
- msg <- "@HydraulicRedistribution_use must have NVEGTYPES values."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@HydraulicRedistribution)
- if (identical(temp, c(3, nvegs))) {
- msg <- "@HydraulicRedistribution must be a 3xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- if (length(object@CriticalSoilWaterPotential) != nvegs ||
- !all(object@CriticalSoilWaterPotential < 0)) {
- msg <- "@CriticalSoilWaterPotential must have NVEGTYPES negative values."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- temp <- dim(object@CO2Coefficients)
- if (identical(temp, c(4, nvegs))) {
- msg <- "@CO2Coefficients must be a 4xNVEGTYPES matrix."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ if (
+ length(object@Composition) != 1L + nvegs ||
+ !all(is.na(object@Composition) | (object@Composition >= 0. &
+ object@Composition <= 1.))
+ ) {
+ msg <- paste(
+ "@Composition must have 1 + NVEGTYPES values",
+ "between 0 and 1 or NA."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (
+ length(object@Albedo) != 1L + nvegs ||
+ !all(is.na(object@Albedo) | (object@Albedo >= 0. & object@Albedo <= 1.))
+ ) {
+ msg <- "@Albedo must have 1 + NVEGTYPES values between 0 and 1 or NA."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@CanopyHeight)
+ if (!identical(temp, c(5L, nvegs))) {
+ msg <- "@CanopyHeight must be a 5xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@VegetationInterceptionParameters)
+ if (!identical(temp, c(2L, nvegs))) {
+ msg <- "@VegetationInterceptionParameters must be a 4xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@LitterInterceptionParameters)
+ if (!identical(temp, c(1L, nvegs))) {
+ msg <- "@LitterInterceptionParameters must be a 1xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@EsTpartitioning_param) != nvegs) {
+ msg <- "@EsTpartitioning_param must have NVEGTYPES values."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (
+ length(object@Es_param_limit) != nvegs ||
+ !all(is.na(object@Es_param_limit) | object@Es_param_limit >= 0.)
+ ) {
+ msg <- "@Es_param_limit must have NVEGTYPES non-negative values."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@Shade)
+ if (!identical(temp, c(6L, nvegs))) {
+ msg <- "@Shade must be a 6xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@HydraulicRedistribution_use) != nvegs) {
+ msg <- "@HydraulicRedistribution_use must have NVEGTYPES values."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@HydraulicRedistribution)
+ if (!identical(temp, c(3L, nvegs))) {
+ msg <- "@HydraulicRedistribution must be a 3xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@CriticalSoilWaterPotential) != nvegs ||
+ !all(
+ is.na(object@CriticalSoilWaterPotential) |
+ object@CriticalSoilWaterPotential < 0.
+ )
+ ) {
+ msg <- "@CriticalSoilWaterPotential must have NVEGTYPES negative values."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ temp <- dim(object@CO2Coefficients)
+ if (!identical(temp, c(4L, nvegs))) {
+ msg <- "@CO2Coefficients must be a 4xNVEGTYPES matrix."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (
+ length(object@MonthlyVeg) != nvegs ||
+ !all(
+ vapply(
+ object@MonthlyVeg,
+ function(x) identical(dim(x), c(12L, 4L)),
+ FUN.VALUE = NA
+ )
+ )
+ ) {
+ msg <- paste(
+ "@MonthlyVeg must be a list with NVEGTYPES elements of a",
+ "12x4 matrix."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ val
}
-
- if (length(object@MonthlyVeg) != nvegs ||
- any(sapply(object@MonthlyVeg,
- function(x) !identical(dim(x), c(12L, 4L))))) {
- msg <- paste("@MonthlyVeg must be a list with NVEGTYPES elements of a",
- "12x4 matrix.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
-
- val
-}
-setValidity("swProd", swProd_validity)
+)
#' @rdname swProd-class
#' @export
-setMethod("initialize", signature = "swProd", function(.Object, ...) {
+swProd <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "prod")
- sns <- slotNames(def)
+ sns <- slotNames("swProd")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swProd")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
# We don't set values for slot `Composition`; this is to prevent simulation
@@ -161,28 +293,52 @@ setMethod("initialize", signature = "swProd", function(.Object, ...) {
def@Composition[] <- NA_real_
}
- # Guarantee dimnames of dots arguments
- gdns <- c("CanopyHeight", "VegetationInterceptionParameters",
+ # Guarantee names
+ gdns <- c(
+ "CanopyHeight", "VegetationInterceptionParameters",
"LitterInterceptionParameters", "HydraulicRedistribution",
- "CO2Coefficients", "MonthlyVeg")
+ "CO2Coefficients"
+ )
for (g in gdns) if (g %in% dns) {
dimnames(dots[[g]]) <- dimnames(slot(def, g))
}
- # Initialize values
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ if ("MonthlyVeg" %in% dns) {
+ for (kveg in veg_names) {
+ dimnames(dots[["MonthlyVeg"]][[kveg]]) <- dimnames(
+ slot(def, "MonthlyVeg")[[kveg]]
+ )
+ }
}
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call("new", args = c("swProd", tmp))
+}
- validObject(.Object)
- .Object
-})
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swProd",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swProd`.")
+ }
+ object <- suppressWarnings(swProd(object))
+ }
+
+ object
+ }
+)
#' @rdname swProd-class
@@ -203,214 +359,314 @@ setMethod("swProd_CanopyHeight", "swProd", function(object) object@CanopyHeight)
#' @rdname swProd-class
#' @export
-setMethod("swProd_VegInterParam", "swProd",
- function(object) object@VegetationInterceptionParameters)
+setMethod(
+ "swProd_VegInterParam",
+ "swProd",
+ function(object) object@VegetationInterceptionParameters
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_LitterInterParam", "swProd",
- function(object) object@LitterInterceptionParameters)
+setMethod(
+ "swProd_LitterInterParam",
+ "swProd",
+ function(object) object@LitterInterceptionParameters
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_EsTpartitioning_param", "swProd",
- function(object) object@EsTpartitioning_param)
+setMethod(
+ "swProd_EsTpartitioning_param",
+ "swProd",
+ function(object) object@EsTpartitioning_param
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_Es_param_limit", "swProd",
- function(object) object@Es_param_limit)
+setMethod(
+ "swProd_Es_param_limit",
+ "swProd",
+ function(object) object@Es_param_limit
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_Shade", "swProd", function(object) object@Shade)
+setMethod(
+ "swProd_Shade",
+ "swProd",
+ function(object) object@Shade
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_HydrRedstro_use", "swProd",
- function(object) object@HydraulicRedistribution_use)
+setMethod(
+ "swProd_HydrRedstro_use",
+ "swProd",
+ function(object) object@HydraulicRedistribution_use
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_HydrRedstro", "swProd",
- function(object) object@HydraulicRedistribution)
+setMethod(
+ "swProd_HydrRedstro",
+ "swProd",
+ function(object) object@HydraulicRedistribution
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_CritSoilWaterPotential", "swProd",
- function(object) object@CriticalSoilWaterPotential)
+setMethod(
+ "swProd_CritSoilWaterPotential",
+ "swProd",
+ function(object) object@CriticalSoilWaterPotential
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_CO2Coefficients", "swProd",
- function(object) object@CO2Coefficients)
+setMethod(
+ "swProd_CO2Coefficients",
+ "swProd",
+ function(object) object@CO2Coefficients
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_veg",
+setMethod(
+ "swProd_MonProd_veg",
signature = c(object = "swProd", vegtype = "numeric"),
- function(object, vegtype) object@MonthlyVeg[[as.integer(vegtype)]])
+ function(object, vegtype) object@MonthlyVeg[[as.integer(vegtype)]]
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_veg",
+setMethod(
+ "swProd_MonProd_veg",
signature = c(object = "swProd", vegtype = "character"),
function(object, vegtype) {
- id_vegtype <- grep(vegtype,
- names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]), ignore.case = TRUE)
+ id_vegtype <- grep(
+ vegtype,
+ names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]),
+ ignore.case = TRUE
+ )
object@MonthlyVeg[[id_vegtype]]
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_grass", "swProd", function(object) {
- object@MonthlyVeg[[1 +
- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_GRASS"]]]]
-})
+setMethod(
+ "swProd_MonProd_grass",
+ "swProd",
+ function(object) {
+ object@MonthlyVeg[[
+ 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_GRASS"]]
+ ]]
+ }
+)
+
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_shrub", "swProd", function(object) {
- object@MonthlyVeg[[1 +
- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_SHRUB"]]]]
-})
+setMethod(
+ "swProd_MonProd_shrub",
+ "swProd",
+ function(object) {
+ object@MonthlyVeg[[
+ 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_SHRUB"]]
+ ]]
+ }
+)
+
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_tree", "swProd", function(object) {
- object@MonthlyVeg[[1 +
- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_TREES"]]]]
-})
+setMethod(
+ "swProd_MonProd_tree",
+ "swProd",
+ function(object) {
+ object@MonthlyVeg[[
+ 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_TREES"]]
+ ]]
+ }
+)
+
#' @rdname swProd-class
#' @export
-setMethod("swProd_MonProd_forb", "swProd", function(object) {
- object@MonthlyVeg[[1 +
- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_FORBS"]]]]
-})
+setMethod(
+ "swProd_MonProd_forb",
+ "swProd",
+ function(object) {
+ object@MonthlyVeg[[
+ 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_FORBS"]]
+ ]]
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("set_swProd", signature = "swProd", function(object, value) {
- object <- value
- validObject(object)
- object
-})
+setReplaceMethod(
+ "set_swProd",
+ signature = "swProd",
+ function(object, value) {
+ object <- value
+ validObject(object)
+ object
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_Composition", signature = "swProd",
+setReplaceMethod(
+ "swProd_Composition",
+ signature = "swProd",
function(object, value) {
object@Composition[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_Albedo", signature = "swProd",
+setReplaceMethod(
+ "swProd_Albedo",
+ signature = "swProd",
function(object, value) {
object@Albedo[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_CanopyHeight", signature = "swProd",
+setReplaceMethod(
+ "swProd_CanopyHeight",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@CanopyHeight)
object@CanopyHeight <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_VegInterParam", signature = "swProd",
+setReplaceMethod(
+ "swProd_VegInterParam",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@VegetationInterceptionParameters)
object@VegetationInterceptionParameters <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_LitterInterParam", signature = "swProd",
+setReplaceMethod(
+ "swProd_LitterInterParam",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@LitterInterceptionParameters)
object@LitterInterceptionParameters <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_EsTpartitioning_param", signature = "swProd",
+setReplaceMethod(
+ "swProd_EsTpartitioning_param",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@EsTpartitioning_param)
object@EsTpartitioning_param <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_Es_param_limit", signature = "swProd",
+setReplaceMethod(
+ "swProd_Es_param_limit",
+ signature = "swProd",
function(object, value) {
object@Es_param_limit[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_Shade", signature = "swProd", function(object, value) {
- dimnames(value) <- dimnames(object@Shade)
- object@Shade <- value
- validObject(object)
- object
-})
+setReplaceMethod(
+ "swProd_Shade",
+ signature = "swProd",
+ function(object, value) {
+ dimnames(value) <- dimnames(object@Shade)
+ object@Shade <- value
+ validObject(object)
+ object
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_HydrRedstro_use", signature = "swProd",
+setReplaceMethod(
+ "swProd_HydrRedstro_use",
+ signature = "swProd",
function(object, value) {
object@HydraulicRedistribution_use[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_HydrRedstro", signature = "swProd",
+setReplaceMethod(
+ "swProd_HydrRedstro",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@HydraulicRedistribution)
object@HydraulicRedistribution <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_CritSoilWaterPotential", signature = "swProd",
+setReplaceMethod(
+ "swProd_CritSoilWaterPotential",
+ signature = "swProd",
function(object, value) {
object@CriticalSoilWaterPotential[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_CO2Coefficients", signature = "swProd",
+setReplaceMethod(
+ "swProd_CO2Coefficients",
+ signature = "swProd",
function(object, value) {
dimnames(value) <- dimnames(object@CO2Coefficients)
object@CO2Coefficients <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_veg",
+setReplaceMethod(
+ "swProd_MonProd_veg",
signature = c(object = "swProd", vegtype = "numeric", value = "matrix"),
function(object, vegtype, value) {
id_vegtype <- as.integer(vegtype)
@@ -418,61 +674,82 @@ setReplaceMethod("swProd_MonProd_veg",
object@MonthlyVeg[[id_vegtype]] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_veg",
+setReplaceMethod(
+ "swProd_MonProd_veg",
signature = c(object = "swProd", vegtype = "character", value = "matrix"),
function(object, vegtype, value) {
- id_vegtype <- grep(vegtype,
- names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]), ignore.case = TRUE)
+ id_vegtype <- grep(
+ vegtype,
+ names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]),
+ ignore.case = TRUE
+ )
swProd_MonProd_veg(object, id_vegtype) <- value
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_grass", signature = "swProd",
+setReplaceMethod(
+ "swProd_MonProd_grass",
+ signature = "swProd",
function(object, value) {
id_vegtype <- 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_GRASS"]]
swProd_MonProd_veg(object, id_vegtype) <- value
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_shrub", signature = "swProd",
+setReplaceMethod(
+ "swProd_MonProd_shrub",
+ signature = "swProd",
function(object, value) {
id_vegtype <- 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_SHRUB"]]
swProd_MonProd_veg(object, id_vegtype) <- value
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_tree", signature = "swProd",
+setReplaceMethod(
+ "swProd_MonProd_tree",
+ signature = "swProd",
function(object, value) {
id_vegtype <- 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_TREES"]]
swProd_MonProd_veg(object, id_vegtype) <- value
object
-})
+ }
+)
+
#' @rdname swProd-class
#' @export
-setReplaceMethod("swProd_MonProd_forb", signature = "swProd",
+setReplaceMethod(
+ "swProd_MonProd_forb",
+ signature = "swProd",
function(object, value) {
id_vegtype <- 1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_FORBS"]]
swProd_MonProd_veg(object, id_vegtype) <- value
object
-})
+ }
+)
#' @rdname swProd-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object = "swProd", file = "character"),
+setMethod(
+ "swReadLines",
+ signature = c(object = "swProd", file = "character"),
function(object, file) {
- print("TODO: method 'swReadLines' is not up-to-date; hard-coded indices are incorrect")
+ stop("swReadLines is defunct")
infiletext <- readLines(con = file)
object@Composition = readNumerics(infiletext[6],5)
object@Albedo = readNumerics(infiletext[11],5)
@@ -503,5 +780,6 @@ setMethod("swReadLines", signature = c(object = "swProd", file = "character"),
for(i in 1:12) object@MonthlyVeg[[1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_TREES"]]]][i, ] = readNumerics(infiletext[124+i],4)
for(i in 1:12) object@MonthlyVeg[[1 + rSW2_glovars[["kSOILWAT2"]][["VegTypes"]][["SW_FORBS"]]]][i, ] = readNumerics(infiletext[139+i],4)
return(object)
-})
+ }
+)
# nolint end
diff --git a/R/F_swSite.R b/R/F_swSite.R
index 54037568..be5fa293 100644
--- a/R/F_swSite.R
+++ b/R/F_swSite.R
@@ -29,10 +29,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swSite}}.
-#' @param .Object An object of class \code{\linkS4class{swSite}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -44,6 +50,7 @@
#' @examples
#' showClass("swSite")
#' x <- new("swSite")
+#' x <- swSite()
#'
#' @name swSite-class
#' @export
@@ -60,127 +67,191 @@ setClass(
IntrinsicSiteParams = "numeric",
SoilTemperatureFlag = "logical",
SoilTemperatureConstants = "numeric",
- TranspirationRegions = "matrix"
+ SoilDensityInputType = "integer",
+ TranspirationRegions = "matrix",
+ swrc_flags = "character",
+ has_swrcp = "logical"
+ ),
+ prototype = list(
+ SWClimits = c(swc_min = NA_real_, swc_init = NA_real_, swc_wet = NA_real_),
+ ModelFlags = c(Reset = NA, DeepDrain = NA),
+ ModelCoefficients = c(
+ PETmultiplier = NA_real_,
+ DailyRunoff = NA_real_,
+ DailyRunon = NA_real_
+ ),
+ SnowSimulationParameters = stats::setNames(
+ rep(NA_real_, 5L),
+ c("TminAccu2", "TmaxCrit", "lambdaSnow", "RmeltMin", "RmeltMax")
+ ),
+ DrainageCoefficient = c("SlowDrainCoefficientPerYear_cm/dy" = NA_real_),
+ EvaporationCoefficients = stats::setNames(
+ rep(NA_real_, 4L),
+ c("RateShift", "RateSlope", "InflectionPoint", "Range")
+ ),
+ TranspirationCoefficients = stats::setNames(
+ rep(NA_real_, 4L),
+ c("RateShift", "RateShape", "InflectionPoint", "Range")
+ ),
+ IntrinsicSiteParams = stats::setNames(
+ rep(NA_real_, 5L),
+ c("Longitude", "Latitude", "Altitude", "Slope", "Aspect")
+ ),
+ SoilTemperatureFlag = NA,
+ SoilTemperatureConstants = stats::setNames(
+ rep(NA_real_, 10L),
+ c(
+ "BiomassLimiter_g/m^2", "T1constant_a", "T1constant_b", "T1constant_c",
+ "cs_constant_SoilThermCondct", "cs_constant",
+ "sh_constant_SpecificHeatCapacity",
+ "ConstMeanAirTemp", "deltaX_Param", "MaxDepth"
+ )
+ ),
+ SoilDensityInputType = NA_integer_,
+ TranspirationRegions = array(
+ NA_integer_,
+ dim = c(3L, 2L),
+ dimnames = list(NULL, c("ndx", "layer"))
+ ),
+ swrc_flags = c(swrc_name = NA_character_, ptf_name = NA_character_),
+ has_swrcp = NA
)
)
-setValidity("swSite", function(object) {
- val <- TRUE
+setValidity(
+ "swSite",
+ function(object) {
+ val <- TRUE
- if (length(object@SWClimits) != 3) {
- msg <- "@SWClimits length != 3."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@ModelFlags) != 2) {
- msg <- "@ModelFlags length != 2."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(object@SWClimits) != 3L) {
+ msg <- "@SWClimits length != 3."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@ModelFlags) != 2L) {
+ msg <- "@ModelFlags length != 2."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@ModelCoefficients) != 3) {
- msg <- "@ModelCoefficients length != 3."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- x <- slot(object, "ModelCoefficients")[1]
- if (!is.na(x) && x < 0) {
- msg <- paste("@ModelCoefficients:PETmultiplier =", x,
- "must be a non-negative number")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- x <- slot(object, "ModelCoefficients")[2]
- if (!is.na(x) && !(x >= 0 && x <= 1)) {
- msg <- paste("@ModelCoefficients:DailyRunoff =", x,
- "must be a number between 0 and 1",
- "(inclusive)")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- x <- slot(object, "ModelCoefficients")[3]
- if (!is.na(x) && x < 0) {
- msg <- paste("@ModelCoefficients:DailyRunon =", x,
- "must be a non-negative number")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(object@ModelCoefficients) != 3L) {
+ msg <- "@ModelCoefficients length != 3."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (length(object@SnowSimulationParameters) != 5) {
- msg <- "@SnowSimulationParameters length != 5."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@DrainageCoefficient) != 1) {
- msg <- "@DrainageCoefficient length != 1."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@EvaporationCoefficients) != 4) {
- msg <- "@EvaporationCoefficients length != 4."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@TranspirationCoefficients) != 4) {
- msg <- "@TranspirationCoefficients length != 4."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@IntrinsicSiteParams) != 5) {
- msg <- "@IntrinsicSiteParams length != 5."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (length(object@SoilTemperatureFlag) != 1) {
- msg <- "@SoilTemperatureFlag length != 1."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ if (length(object@SnowSimulationParameters) != 5L) {
+ msg <- "@SnowSimulationParameters length != 5."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@DrainageCoefficient) != 1L) {
+ msg <- "@DrainageCoefficient length != 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@EvaporationCoefficients) != 4L) {
+ msg <- "@EvaporationCoefficients length != 4."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@TranspirationCoefficients) != 4L) {
+ msg <- "@TranspirationCoefficients length != 4."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@IntrinsicSiteParams) != 5L) {
+ msg <- "@IntrinsicSiteParams length != 5."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@SoilTemperatureFlag) != 1L) {
+ msg <- "@SoilTemperatureFlag length != 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@SoilTemperatureConstants) != 10L) {
+ msg <- "@SoilTemperatureConstants length != 10."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (length(object@SoilDensityInputType) != 1L) {
+ msg <- "@SoilDensityInputType length != 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (NCOL(object@TranspirationRegions) != 2L) {
+ msg <- "@TranspirationRegions columns != 2."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (typeof(object@TranspirationRegions) != "integer") {
+ msg <- "@TranspirationRegions must be integers."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@swrc_flags) != 2L) {
+ msg <- "@swrc_flags length != 2."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ if (length(object@has_swrcp) != 1L) {
+ msg <- "@has_swrcp length != 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ val
}
- if (length(object@SoilTemperatureConstants) != 10) {
- msg <- "@SoilTemperatureConstants length != 10."
- val <- if (isTRUE(val)) msg else c(val, msg)
+)
+
+#' @rdname swSite-class
+#' @export
+swSite <- function(...) {
+ def <- slot(rSOILWAT2::sw_exampleData, "site")
+ sns <- slotNames("swSite")
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swSite")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
}
- if (typeof(object@TranspirationRegions) != "integer") {
- msg <- "@TranspirationRegions is of integer type."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ dns <- names(dots)
+
+ # We don't set values for slots `IntrinsicSiteParams` and
+ # `TranspirationRegions`; this is to prevent simulation runs with
+ # accidentally incorrect values
+ if (!("IntrinsicSiteParams" %in% dns)) {
+ tmp <- c("Longitude", "Latitude", "Altitude", "Slope", "Aspect")
+ def@IntrinsicSiteParams[tmp] <- NA_real_
}
- if (NCOL(object@TranspirationRegions) != 2) {
- msg <- "@TranspirationRegions columns != 2."
- val <- if (isTRUE(val)) msg else c(val, msg)
+ if (!("TranspirationRegions" %in% dns)) {
+ def@TranspirationRegions[, "layer"] <- NA_integer_
+ } else {
+ # Guarantee names
+ dimnames(dots[["TranspirationRegions"]]) <- list(
+ NULL,
+ colnames(def@TranspirationRegions)
+ )
}
- if (typeof(object@TranspirationRegions) != "integer") {
- msg <- "@TranspirationRegions must be integers."
- val <- if (isTRUE(val)) msg else c(val, msg)
+
+ if ("swrc_flags" %in% dns) {
+ # Guarantee names
+ names(dots[["swrc_flags"]]) <- names(def@swrc_flags)
}
- val
-})
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call("new", args = c("swSite", tmp))
+}
-#' @rdname swSite-class
-#' @export
-setMethod(
- f = "initialize",
- signature = "swSite",
- function(.Object, ...) {
- def <- slot(rSOILWAT2::sw_exampleData, "site")
- sns <- slotNames(def)
- dots <- list(...)
- dns <- names(dots)
-
- # We don't set values for slots `IntrinsicSiteParams` and
- # `TranspirationRegions`; this is to prevent simulation runs with
- # accidentally incorrect values
- if (!("IntrinsicSiteParams" %in% dns)) {
- tmp <- c("Longitude", "Latitude", "Altitude", "Slope", "Aspect")
- def@IntrinsicSiteParams[tmp] <- NA_real_
- }
- if (!("TranspirationRegions" %in% dns)) {
- def@TranspirationRegions[, "layer"] <- NA_integer_
- } else {
- # Guarantee dimnames
- dimnames(dots[["TranspirationRegions"]]) <-
- dimnames(def@TranspirationRegions)
- }
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swSite",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swSite`.")
+ }
+ object <- suppressWarnings(swSite(object))
}
- validObject(.Object)
- .Object
+ object
}
)
@@ -189,154 +260,265 @@ setMethod(
#' @export
setMethod("get_swSite", "swSite", function(object) object)
+#' @rdname swSite_SWRCflags
+setMethod(
+ "swSite_SWRCflags",
+ signature = "swSite",
+ function(object) slot(object, "swrc_flags")
+)
+
+#' @rdname swSite_hasSWRCp
+setMethod(
+ "swSite_hasSWRCp",
+ signature = "swSite",
+ function(object) slot(object, "has_swrcp")
+)
+
+
#' @rdname swSite-class
#' @export
-setMethod("swSite_SWClimits", "swSite",
- function(object) slot(object, "SWClimits"))
+setMethod(
+ "swSite_SWClimits",
+ "swSite",
+ function(object) slot(object, "SWClimits")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_ModelFlags", "swSite",
- function(object) slot(object, "ModelFlags"))
+setMethod(
+ "swSite_ModelFlags",
+ "swSite",
+ function(object) slot(object, "ModelFlags")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_ModelCoefficients", "swSite",
- function(object) slot(object, "ModelCoefficients"))
+setMethod(
+ "swSite_ModelCoefficients",
+ "swSite",
+ function(object) slot(object, "ModelCoefficients")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_SnowSimulationParams", "swSite",
- function(object) slot(object, "SnowSimulationParameters"))
+setMethod(
+ "swSite_SnowSimulationParams",
+ "swSite",
+ function(object) slot(object, "SnowSimulationParameters")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_DrainageCoefficient", "swSite",
- function(object) slot(object, "DrainageCoefficient"))
+setMethod(
+ "swSite_DrainageCoefficient",
+ "swSite",
+ function(object) slot(object, "DrainageCoefficient")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_EvapCoefficients", "swSite",
- function(object) slot(object, "EvaporationCoefficients"))
+setMethod(
+ "swSite_EvapCoefficients",
+ "swSite",
+ function(object) slot(object, "EvaporationCoefficients")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_TranspCoefficients", "swSite",
- function(object) slot(object, "TranspirationCoefficients"))
+setMethod(
+ "swSite_TranspCoefficients",
+ "swSite",
+ function(object) slot(object, "TranspirationCoefficients")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_IntrinsicSiteParams", "swSite",
- function(object) slot(object, "IntrinsicSiteParams"))
+setMethod(
+ "swSite_IntrinsicSiteParams",
+ "swSite",
+ function(object) slot(object, "IntrinsicSiteParams")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_SoilTemperatureFlag", "swSite",
- function(object) slot(object, "SoilTemperatureFlag"))
+setMethod(
+ "swSite_SoilTemperatureFlag",
+ "swSite",
+ function(object) slot(object, "SoilTemperatureFlag")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_SoilTemperatureConsts", "swSite",
- function(object) slot(object, "SoilTemperatureConstants"))
+setMethod(
+ "swSite_SoilTemperatureConsts",
+ "swSite",
+ function(object) slot(object, "SoilTemperatureConstants")
+)
#' @rdname swSite-class
#' @export
-setMethod("swSite_TranspirationRegions", "swSite",
- function(object) slot(object, "TranspirationRegions"))
+setMethod(
+ "swSite_TranspirationRegions",
+ "swSite",
+ function(object) slot(object, "TranspirationRegions")
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("set_swSite", signature = "swSite",
+setMethod(
+ "swSite_SoilDensityInputType",
+ "swSite",
+ function(object) slot(object, "SoilDensityInputType")
+)
+
+#' @rdname swSite-class
+#' @export
+setReplaceMethod(
+ "set_swSite",
+ signature = "swSite",
definition = function(object, value) {
object <- value
validObject(object)
object
-})
+ }
+)
+
+#' @rdname swSite_SWRCflags
+setReplaceMethod(
+ "swSite_SWRCflags",
+ signature = "swSite",
+ definition = function(object, value) {
+ object@swrc_flags[] <- as.character(value)
+ validObject(object)
+ object
+ }
+)
+
+
+#' @rdname swSite_hasSWRCp
+setReplaceMethod(
+ "swSite_hasSWRCp",
+ signature = "swSite",
+ definition = function(object, value) {
+ object@has_swrcp <- isTRUE(as.logical(value))
+ validObject(object)
+ object
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_SWClimits", signature = "swSite",
+setReplaceMethod(
+ "swSite_SWClimits",
+ signature = "swSite",
definition = function(object, value) {
object@SWClimits[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_ModelFlags", signature = "swSite",
+setReplaceMethod(
+ "swSite_ModelFlags",
+ signature = "swSite",
definition = function(object, value) {
object@ModelFlags[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_ModelCoefficients", signature = "swSite",
+setReplaceMethod(
+ "swSite_ModelCoefficients",
+ signature = "swSite",
definition = function(object, value) {
object@ModelCoefficients[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_SnowSimulationParams", signature = "swSite",
+setReplaceMethod(
+ "swSite_SnowSimulationParams",
+ signature = "swSite",
definition = function(object, value) {
object@SnowSimulationParameters[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_DrainageCoefficient", signature = "swSite",
+setReplaceMethod(
+ "swSite_DrainageCoefficient",
+ signature = "swSite",
definition = function(object, value) {
object@DrainageCoefficient[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_EvapCoefficients", signature = "swSite",
+setReplaceMethod(
+ "swSite_EvapCoefficients",
+ signature = "swSite",
definition = function(object, value) {
object@EvaporationCoefficients[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_TranspCoefficients", signature = "swSite",
+setReplaceMethod(
+ "swSite_TranspCoefficients",
+ signature = "swSite",
definition = function(object, value) {
object@TranspirationCoefficients[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_IntrinsicSiteParams", signature = "swSite",
+setReplaceMethod(
+ "swSite_IntrinsicSiteParams",
+ signature = "swSite",
definition = function(object, value) {
object@IntrinsicSiteParams[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_SoilTemperatureFlag", signature = "swSite",
+setReplaceMethod(
+ "swSite_SoilTemperatureFlag",
+ signature = "swSite",
definition = function(object, value) {
object@SoilTemperatureFlag <- as.logical(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_SoilTemperatureConsts", signature = "swSite",
+setReplaceMethod(
+ "swSite_SoilTemperatureConsts",
+ signature = "swSite",
definition = function(object, value) {
object@SoilTemperatureConstants[] <- value
validObject(object)
@@ -345,7 +527,21 @@ setReplaceMethod("swSite_SoilTemperatureConsts", signature = "swSite",
#' @rdname swSite-class
#' @export
-setReplaceMethod("swSite_TranspirationRegions", signature = "swSite",
+setReplaceMethod(
+ "swSite_SoilDensityInputType",
+ signature = "swSite",
+ definition = function(object, value) {
+ object@SoilDensityInputType <- as.integer(value[1L])
+ validObject(object)
+ object
+ }
+)
+
+#' @rdname swSite-class
+#' @export
+setReplaceMethod(
+ "swSite_TranspirationRegions",
+ signature = "swSite",
definition = function(object, value) {
if (typeof(value) != "integer") {
# Check whether we can convert to integer without great loss of info
@@ -357,20 +553,26 @@ setReplaceMethod("swSite_TranspirationRegions", signature = "swSite",
}
# otherwise, we copy non-integer values which will trigger `validObject`
}
- colnames(value) <- colnames(object@TranspirationRegions)
- object@TranspirationRegions <- array(as.integer(value), dim = dim(value),
- dimnames = dimnames(value))
+ object@TranspirationRegions <- array(
+ as.integer(value),
+ dim = dim(value),
+ dimnames = list(NULL, colnames(object@TranspirationRegions))
+ )
validObject(object)
object
-})
+ }
+)
#' @rdname swSite-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object="swSite",file="character"), function(object,file) {
- print("TODO: method 'swReadLines' is not up-to-date; hard-coded indices are incorrect")
+setMethod(
+ "swReadLines",
+ signature = c(object="swSite",file="character"),
+ function(object,file) {
+ print("TODO: method 'swReadLines' is not up-to-date; hard-coded indices are incorrect")
infiletext <- readLines(con = file)
object@SWClimits[1] = readNumeric(infiletext[2])
object@SWClimits[2] = readNumeric(infiletext[3])
diff --git a/R/F_swSoils.R b/R/F_swSoils.R
index 57b71767..def1e8f2 100644
--- a/R/F_swSoils.R
+++ b/R/F_swSoils.R
@@ -28,10 +28,16 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swSoils}}.
-#' @param .Object An object of class \code{\linkS4class{swSoils}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -43,57 +49,138 @@
#' @examples
#' showClass("swSoils")
#' x <- new("swSoils")
+#' x <- swSoils()
#'
#' @name swSoils-class
#' @export
-setClass("swSoils", slots = c(Layers = "matrix"))
+setClass(
+ "swSoils",
+ slots = c(
+ Layers = "matrix",
+ SWRCp = "matrix"
+ ),
+ prototype = list(
+ Layers = array(
+ NA_real_,
+ dim = c(0L, 12L),
+ dimnames = list(
+ NULL,
+ c(
+ "depth_cm", "bulkDensity_g/cm^3", "gravel_content",
+ "EvapBareSoil_frac", "transpGrass_frac", "transpShrub_frac",
+ "transpTree_frac", "transpForb_frac", "sand_frac", "clay_frac",
+ "impermeability_frac", "soilTemp_c"
+ )
+ )
+ ),
+ SWRCp = array(
+ NA_real_,
+ dim = c(0L, 6L),
+ dimnames = list(
+ NULL,
+ paste0("Param", seq_len(6L))
+ )
+ )
+ )
+)
-swSoilLayers_validity <- function(object) {
- val <- TRUE
- temp <- dim(object@Layers)
- dtol1 <- 1 + temp[1] * rSW2_glovars[["tol"]]
- if (temp[1] == 0) {
- msg <- "@Layers must have at least one row/soil layer."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (temp[2] != 12) {
- msg <- paste(
- "@Layers must have exactly 12 columns corresponding to",
- "depth_cm, bulkDensity_g/cm^3, gravel_content, EvapBareSoil_frac,",
- "transpGrass_frac,transpShrub_frac, transpTree_frac, transpForb_frac,",
- "sand_frac, clay_frac, impermeability_frac, soilTemp_c"
- )
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (!all(is.na(object@Layers[, 1])) && (any(object@Layers[, 1] <= 0) ||
- any(diff(object@Layers[, 1]) < rSW2_glovars[["tol"]]))) {
- msg <- "@Layers['depth_cm', ] must be positive increasing depths."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- if (!all(is.na(object@Layers[, 3:11])) && (any(object@Layers[, 3:11] < 0) ||
- any(object@Layers[, 3:11] > dtol1))) {
- msg <- paste("@Layers values of gravel, evco, trcos, sand, clay, and",
- "impermeability must be between 0 and 1.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
- temp <- colSums(object@Layers[, 4:8, drop = FALSE])
- if (any(temp > dtol1, na.rm = TRUE)) {
- msg <- paste("@Layers values of profile sums of evco and trcos must be",
- "between 0 and 1.")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+setValidity(
+ "swSoils",
+ function(object) {
+ val <- TRUE
+ tmpL <- dim(object@Layers)
+ tmpp <- dim(object@SWRCp)
+ dtol1 <- 1. + tmpL[1] * rSW2_glovars[["tol"]]
- val
-}
-setValidity("swSoils", swSoilLayers_validity)
+ #--- Check "Layers"
+ if (tmpL[2] != 12L) {
+ msg <- paste(
+ "@Layers must have exactly 12 columns corresponding to",
+ "depth_cm, bulkDensity_g/cm^3, gravel_content, EvapBareSoil_frac,",
+ "transpGrass_frac,transpShrub_frac, transpTree_frac, transpForb_frac,",
+ "sand_frac, clay_frac, impermeability_frac, soilTemp_c"
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ depths <- object@Layers[, 1L]
+
+ if (
+ !(
+ all(is.na(depths)) ||
+ all(depths > 0.) &&
+ !anyNA(
+ rSW2utils::check_monotonic_increase(
+ depths,
+ MARGIN = 2L,
+ strictly = TRUE
+ )
+ )
+ )
+ ) {
+ msg <- paste(
+ "@Layers[, 'depth_cm'] must be positive, strictly increasing depths",
+ "(or all NA)."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+
+ tmp <- object@Layers[, 3L:11L]
+ if (!(all(is.na(tmp)) || all(tmp >= 0., tmp <= dtol1))) {
+ msg <- paste(
+ "@Layers values of gravel, evco, trcos, sand, clay, and",
+ "impermeability must be between 0 and 1",
+ "(or all NA)."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ tmp <- colSums(object@Layers[, 4L:8L, drop = FALSE])
+ if (!(all(is.na(tmp)) || all(tmp <= dtol1, na.rm = TRUE))) {
+ msg <- paste(
+ "@Layers values of profile sums of evco and trcos must be",
+ "between 0 and 1",
+ "(or all NA)."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ #--- Check "SWRCp"
+ # `SW_SIT_init_run()` will call function to check validity of SWRCp values
+ if (tmpp[1L] != tmpL[1L]) {
+ msg <- paste(
+ "@SWRCp must have exactly the same number of soil layers (rows)",
+ "as @Layers."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+ if (
+ tmpp[2L] != rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SWRC_PARAM_NMAX"]]
+ ) {
+ msg <- paste(
+ "@SWRCp must have exactly",
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SWRC_PARAM_NMAX"]],
+ "columns."
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
+
+ val
+ }
+)
#' @rdname swSoils-class
#' @export
-setMethod("initialize", signature = "swSoils", function(.Object, ...) {
+swSoils <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "soils")
- sns <- slotNames(def)
+ sns <- slotNames("swSoils")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swSoils")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
# We don't set values for slot `Layers` if not passed via ...; this
@@ -101,63 +188,144 @@ setMethod("initialize", signature = "swSoils", function(.Object, ...) {
if (!("Layers" %in% dns)) {
def@Layers <- def@Layers[1, , drop = FALSE]
def@Layers[] <- NA_real_
+ ntmp <- 1
} else {
- # Guarantee dimnames
- dimnames(dots[["Layers"]]) <- dimnames(def@Layers)
+ # Guarantee names
+ dimnames(dots[["Layers"]]) <- list(NULL, colnames(def@Layers))
+ ntmp <- nrow(dots[["Layers"]])
}
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ # 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 {
+ # Guarantee names
+ dimnames(dots[["SWRCp"]]) <- list(NULL, colnames(def@SWRCp))
}
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- validObject(.Object)
- .Object
-})
+ do.call("new", args = c("swSoils", tmp))
+}
-#' @rdname swSoils-class
+
+#' @rdname sw_upgrade
#' @export
-setMethod("get_swSoils", "swSoils", function(object) object)
+setMethod(
+ "sw_upgrade",
+ signature = "swSoils",
+ definition = function(object, verbose = FALSE) {
+ #--- Make sure we have SWRC parameters
+ tmp <- try(object@SWRCp, silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swSoils`.")
+ }
+ object <- suppressWarnings(swSoils(object))
+ }
+
+ object
+ }
+)
+
#' @rdname swSoils-class
#' @export
+setMethod("get_swSoils", "swSoils", function(object) object)
+
+#' @rdname swSoils_Layers
setMethod("swSoils_Layers", "swSoils", function(object) object@Layers)
+#' @rdname swSoils_SWRCp
+setMethod("swSoils_SWRCp", "swSoils", function(object) object@SWRCp)
+
#' @rdname swSoils-class
#' @export
-setReplaceMethod("set_swSoils",
+setReplaceMethod(
+ "set_swSoils",
signature = c(object = "swSoils", value = "swSoils"),
function(object, value) {
colnames(value@Layers) <- colnames(object@Layers)
+ colnames(value@SWRCp) <- colnames(object@SWRCp)
object <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSoils-class
#' @export
-setReplaceMethod("swSoils_Layers",
- signature = c(object = "swSoils", value = "matrix"),
+setReplaceMethod(
+ "set_swSoils",
+ signature = c(object = "swSoils", value = "list"),
+ function(object, value) {
+ idl <- if (utils::hasName(value, "Layers")) "Layers" else 1
+ idp <- if (utils::hasName(value, "SWRCp")) "SWRCp" else 2
+ colnames(value[[idl]]) <- colnames(object@Layers)
+ colnames(value[[idp]]) <- colnames(object@SWRCp)
+ object@Layers <- data.matrix(value[[idl]])
+ object@SWRCp <- data.matrix(value[[idp]])
+ validObject(object)
+ object
+ }
+)
+
+#' @rdname swSoils_Layers
+setReplaceMethod(
+ "swSoils_Layers",
+ signature = "swSoils",
function(object, value) {
colnames(value) <- colnames(object@Layers)
- object@Layers <- value
+ object@Layers <- data.matrix(value)
+ # Note: validity check fails if number of soil layers disagrees with
+ # number of of soil layers of SWRC parameters
+ # --> see method for "swInputData" that can automatically resizes SWRCp
+ validObject(object)
+ object
+ }
+)
+
+
+#' @rdname swSoils_SWRCp
+setReplaceMethod(
+ "swSoils_SWRCp",
+ signature = "swSoils",
+ function(object, value) {
+ colnames(value) <- colnames(object@SWRCp)
+ object@SWRCp <- data.matrix(value)
validObject(object)
object
-})
+ }
+)
+
+
+
+reset_SWRCp <- function(SWRCp, new_nrow = 1L) {
+ array(
+ data = NA_real_,
+ dim = c(new_nrow, ncol(SWRCp)),
+ dimnames = list(NULL, colnames(SWRCp))
+ )
+}
+
#' @rdname swSoils-class
#' @export
# nolint start
-setMethod("swReadLines",
+setMethod(
+ "swReadLines",
signature = c(object = "swSoils", file = "character"),
function(object, file) {
- print("TODO: method 'swReadLines' is not up-to-date; hard-coded indices are incorrect")
+ stop("This function no longer works correctly; and SWRCp are not read.")
infiletext <- readLines(con = file)
infiletext <- infiletext[infiletext != ""] #get rid of extra spaces
infiletext <- infiletext[17:length(infiletext)] #get rid of comments
@@ -171,5 +339,6 @@ setMethod("swReadLines",
}
object
-})
+ }
+)
# nolint end
diff --git a/R/G_swOut.R b/R/G_swOut.R
index 349aa0b0..8d87a039 100644
--- a/R/G_swOut.R
+++ b/R/G_swOut.R
@@ -29,56 +29,88 @@
#' The methods listed below work on this class and the proper slot of the class
#' \code{\linkS4class{swInputData}}.
#'
-#' @param .Object An object of class \code{\linkS4class{swOUT_key}}.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @examples
#' showClass("swOUT_key")
#' x <- new("swOUT_key")
+#' x <- swOUT_key()
#'
#' @name swOUT_key-class
#' @export
-setClass("swOUT_key", slots = c(mykey = "integer", myobj = "integer",
- sumtype = "integer", use = "logical", first_orig = "integer",
- last_orig = "integer", outfile = "character"))
+setClass(
+ "swOUT_key",
+ slots = c(
+ mykey = "integer",
+ myobj = "integer",
+ sumtype = "integer",
+ use = "logical",
+ first_orig = "integer",
+ last_orig = "integer",
+ outfile = "character"
+ ),
+ # TODO: lengths must be rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ prototype = list(
+ mykey = rep(NA_integer_, 32L),
+ myobj = rep(NA_integer_, 32L),
+ sumtype = rep(NA_integer_, 32L),
+ use = rep(NA, 32L),
+ first_orig = rep(NA_integer_, 32L),
+ last_orig = rep(NA_integer_, 32L),
+ outfile = rep(NA_character_, 32L)
+ )
+)
-swOUT_key_validity <- function(object) {
- val <- TRUE
+setValidity(
+ "swOUT_key",
+ function(object) {
+ val <- TRUE
- temp <- lengths(lapply(slotNames(object), function(x) slot(object, x)))
+ temp <- lengths(lapply(slotNames(object), function(x) slot(object, x)))
- id <- temp != rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ id <- temp != rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
- if (any(id)) {
- msg <- paste0(names(temp)[id], " must be a vector of length 'SW_OUTNKEYS'")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (any(id)) {
+ msg <- paste0(
+ names(temp)[id],
+ " must be a vector of length 'SW_OUTNKEYS'"
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- val
-}
-setValidity("swOUT_key", swOUT_key_validity)
+ val
+ }
+)
#' @rdname swOUT_key-class
#' @export
-setMethod("initialize", signature = "swOUT_key", function(.Object, ...) {
+swOUT_key <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "output")
sns <- slotNames("swOUT_key")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swOUT_key")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
-
- validObject(.Object)
- .Object
-})
+ do.call("new", args = c("swOUT_key", tmp))
+}
###########################OUTSETUP.IN########################################
@@ -89,10 +121,16 @@ setMethod("initialize", signature = "swOUT_key", function(.Object, ...) {
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swOUT}}.
-#' @param .Object An object of class \code{\linkS4class{swOUT}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @slot outputSeparator A character string. Currently, only \var{"\\t"} is
#' functional.
@@ -121,68 +159,218 @@ setMethod("initialize", signature = "swOUT_key", function(.Object, ...) {
#' @examples
#' showClass("swOUT")
#' x <- new("swOUT")
+#' x <- swOUT()
#'
#' @name swOUT-class
#' @export
-setClass("swOUT", slot = c(outputSeparator = "character", timeSteps = "matrix"),
- contains = "swOUT_key")
+setClass(
+ "swOUT",
+ slot = c(
+ outputSeparator = "character",
+ timeSteps = "matrix"
+ ),
+ contains = "swOUT_key",
+ prototype = list(
+ outputSeparator = NA_character_,
+ # timeSteps:
+ # * 999 must be rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]]
+ # * nrows = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ # * ncols = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]
+ timeSteps = array(999, dim = c(32L, 4L))
+ )
+)
-swOUT_validity <- function(object) {
- val <- TRUE
- if (length(object@outputSeparator) != 1) {
- msg <- "@outputSeparator needs to be of length 1."
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+setValidity(
+ "swOUT",
+ function(object) {
+ val <- TRUE
- if (length(dim(object@timeSteps)) != 2) {
- msg <- "@timeSteps must be a 2-dimensional matrix"
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(object@outputSeparator) != 1L) {
+ msg <- "@outputSeparator needs to be of length 1."
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (nrow(object@timeSteps) !=
- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]) {
- msg <- "@timeSteps must be a matrix with 'SW_OUTNKEYS' rows"
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (length(dim(object@timeSteps)) != 2L) {
+ msg <- "@timeSteps must be a 2-dimensional matrix"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (ncol(object@timeSteps) !=
- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]) {
- msg <- "@timeSteps must be a matrix with 'SW_OUTNPERIODS' columns"
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ if (
+ nrow(object@timeSteps) !=
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ ) {
+ msg <- "@timeSteps must be a matrix with 'SW_OUTNKEYS' rows"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- # timeSteps is base0
- ok <- c(rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]],
- seq_len(rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]) - 1L)
+ if (
+ ncol(object@timeSteps) !=
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]
+ ) {
+ msg <- "@timeSteps must be a matrix with 'SW_OUTNPERIODS' columns"
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- if (!all(object@timeSteps %in% ok)) {
- msg <- paste("@timeSteps values must be within SW_OUTNPERIODS or be",
- "equal to eSW_NoTime")
- val <- if (isTRUE(val)) msg else c(val, msg)
- }
+ # timeSteps is base0
+ ok <- c(
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]],
+ seq_len(rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]) - 1L
+ )
+
+ if (!all(object@timeSteps %in% ok)) {
+ msg <- paste(
+ "@timeSteps values must be within SW_OUTNPERIODS or be",
+ "equal to eSW_NoTime"
+ )
+ val <- if (isTRUE(val)) msg else c(val, msg)
+ }
- val
-}
-setValidity("swOUT", swOUT_validity)
+ val
+ }
+)
#' @rdname swOUT-class
#' @export
-setMethod("initialize", signature = "swOUT", function(.Object, ...) {
+swOUT <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "output")
sns <- setdiff(slotNames("swOUT"), inheritedSlotNames("swOUT"))
dots <- list(...)
- dns <- names(dots)
-
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ if (length(dots) == 1 && inherits(dots[[1]], "swOUT")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
}
+ dns <- setdiff(names(dots), inheritedSlotNames("swOUT"))
+
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call(
+ "new",
+ args = c(
+ "swOUT",
+ if ("swOUT_key" %in% dns) {
+ swOUT_key(dots[["swOUT_key"]])
+ } else {
+ do.call(swOUT_key, dots)
+ },
+ tmp
+ )
+ )
+}
+
+
+#' @rdname sw_upgrade
+#' @export
+setMethod(
+ "sw_upgrade",
+ signature = "swOUT",
+ definition = function(object, verbose = FALSE) {
+ #--- Compare available and expected number of outkeys
+ n_exp <- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ n_has <- nrow(object@timeSteps)
+
+
+ #--- Identify upgrade(s)
+ # Maintenance:
+ # 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
+ )
+
+ do_upgrade <- do_upgrade[do_upgrade]
+
+ if (any(do_upgrade)) {
+ target <- swOUT()
+ stopifnot(nrow(target) == n_exp)
+
+
+ #--- Loop over upgrades sequentially
+ for (k in seq_along(do_upgrade)) {
+
+ if (verbose) {
+ message(
+ "Upgrading object of class `swOUT`: ",
+ shQuote(names(do_upgrade)[k])
+ )
+ }
+
+ # Maintenance: update `switch` when `n_exp` changes!
+ id_new <- switch(
+ EXPR = names(do_upgrade)[k],
+ from_v230 = n_exp,
+ from_v310 = 28L,
+ stop(
+ "Upgrade ", shQuote(names(do_upgrade)[k]),
+ " is not implemented for class `swOUT`."
+ )
+ )
+
+
+ #--- Upgrade `timeSteps`
+ tmp <- object@timeSteps
+
+ # Grab available values or default
+ has_missing <- apply(
+ tmp,
+ MARGIN = 1L,
+ function(object) {
+ any(object == rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]])
+ }
+ )
+ id <- which(!has_missing)
+ tmp_new <- if (length(id) > 0) {
+ tmp[id[[1L]], , drop = FALSE]
+ } else {
+ target@timeSteps[id_new, , drop = FALSE]
+ }
+
+ object@timeSteps <- rbind(
+ if (id_new > 1L) {
+ tmp[1L:(id_new - 1L), , drop = FALSE]
+ },
+ tmp_new,
+ if (id_new <= n_has) {
+ tmp[id_new:n_has, , drop = FALSE]
+ }
+ )
+
+ #--- Upgrade `swOUT_key`s
+ object@mykey <- target@mykey
+
+ list_keys <- c(
+ "myobj", "sumtype", "use", "first_orig", "last_orig", "outfile"
+ )
- .Object <- callNextMethod(.Object, ...)
- validObject(.Object)
- .Object
-})
+ for (sn in list_keys) {
+ tmp <- slot(object, sn)
+ slot(object, sn) <- c(
+ if (id_new > 1L) {
+ tmp[1L:(id_new - 1L)]
+ },
+ slot(target, sn)[id_new],
+ if (id_new <= n_has) {
+ tmp[id_new:n_has]
+ }
+ )
+ }
+
+ }
+
+
+ #--- Check validity and return
+ validObject(object)
+ }
+
+ object
+ }
+)
#' @rdname swOUT-class
@@ -195,21 +383,28 @@ setMethod("swOUT_TimeStep", "swOUT", function(object) object@timeSteps)
#' @rdname swOUT-class
#' @export
-setMethod("swOUT_OutputSeparator", "swOUT",
- function(object) object@outputSeparator)
+setMethod(
+ "swOUT_OutputSeparator",
+ "swOUT",
+ function(object) object@outputSeparator
+)
#' @rdname swOUT-class
#' @export
-setReplaceMethod("set_swOUT", signature = "swOUT", function(object, value) {
- object <- value
- validObject(object)
- object
-})
+setReplaceMethod(
+ "set_swOUT",
+ signature = "swOUT",
+ function(object, value) {
+ object <- value
+ validObject(object)
+ object
+ }
+)
#' @rdname swOUT-class
#' @examples
-#' x <- new("swOUT")
+#' x <- swOUT()
#' activate_swOUT_OutKey(x) <- c("VWCMATRIC", "HYDRED")
#'
#' @export
@@ -266,7 +461,7 @@ setReplaceMethod(
#' @rdname swOUT-class
#' @examples
-#' x <- new("swOUT")
+#' x <- swOUT()
#' deactivate_swOUT_OutKey(x) <- c("VWCMATRIC", "HYDRED")
#'
#' @export
@@ -305,33 +500,47 @@ setReplaceMethod(
#' @rdname swOUT-class
#' @export
-setReplaceMethod("swOUT_TimeStep", signature = "swOUT",
+setReplaceMethod(
+ "swOUT_TimeStep",
+ signature = "swOUT",
function(object, value) {
object@timeSteps <- value
validObject(object)
object
-})
+ }
+)
#' Set time steps to the same set of values for each output key.
#' @examples
-#' x <- new("swOUT")
+#' x <- swOUT()
#' swOUT_TimeStepsForEveryKey(x) <- c(2, 3)
-#' identical(as.vector(unique(swOUT_TimeStep(x))), as.integer(c(2, 3)))
+#' identical(
+#' unique(sort(as.vector(swOUT_TimeStep(x)))),
+#' as.integer(c(2, 3, 999)) # 999 represents 'eSW_NoTime'
+#' )
+#'
#' @rdname swOUT-class
#' @export
-setReplaceMethod("swOUT_TimeStepsForEveryKey", signature = "swOUT",
+setReplaceMethod(
+ "swOUT_TimeStepsForEveryKey",
+ signature = "swOUT",
function(object, value) {
- stopifnot(length(value) <=
- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]])
+ stopifnot(
+ length(value) <= rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]
+ )
# Create empty matrix
- temp <- matrix(rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]],
+ temp <- matrix(
+ data = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["eSW_NoTime"]],
nrow = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]],
- ncol = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]])
+ ncol = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]
+ )
# Fill matrix with requested values
- temp[, seq_along(value)] <- rep(value,
- each = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]])
+ temp[, seq_along(value)] <- rep(
+ as.integer(value),
+ each = rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNKEYS"]]
+ )
# Set unused output keys to no-time
temp[!slot(object, "use"), ] <-
@@ -341,16 +550,20 @@ setReplaceMethod("swOUT_TimeStepsForEveryKey", signature = "swOUT",
validObject(object)
object
-})
+ }
+)
#' @rdname swOUT-class
#' @export
-setReplaceMethod("swOUT_OutputSeparator", signature = "swOUT",
+setReplaceMethod(
+ "swOUT_OutputSeparator",
+ signature = "swOUT",
function(object, value) {
object@outputSeparator <- as.character(value)
validObject(object)
object
-})
+ }
+)
# used by swReadLines
@@ -367,54 +580,63 @@ timePeriods <- c("dy", "wk", "mo", "yr")
#' @rdname swOUT-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object="swOUT",file="character"), function(object,file) {
- print("TODO: method 'swReadLines' for class 'swOUT' is not up-to-date; hard-coded indices are incorrect")
-
- infiletext <- readLines(con = file)
- if(temp<-strsplit(infiletext[41],split=" ")[[1]][2] == "t") {
- object@outputSeparator="\t"
- } else if(temp == "s") {
- object@outputSeparator=" "
- } else if(temp == "c"){
- object@outputSeparator=","
- } else {
- object@outputSeparator="\t"
- }
-
- if(infiletext[42]==""){
- useTimeStep = FALSE
- } else {
- useTimeStep = TRUE
- temp<-strsplit(x=infiletext[42],split=" ")[[1]][-1]
- object@timeSteps = as.integer(sapply(1:length(temp), FUN=function(i) which(temp[i] == timePeriods))-1)
- }
-
- for(i in 45:length(infiletext)) {
- if(infiletext[i] != "") {
- temp<-strsplit(x=infiletext[i],split="\t")[[1]]
- temp<-unlist(strsplit(x=temp,split=" "))
- temp <- temp[temp != ""][1:6]
- mykey<- as.integer(grep(pattern=temp[1],x=KEY)[1])
- sumtype <- as.integer(grep(pattern=temp[2],x=OutSum))-1
- period <- which(tolower(temp[3]) == timePeriods)-1
- start <- as.integer(temp[4])
- if(grepl(pattern="end",x=temp[5])) {
- end <- as.integer(366)
- } else {
- end <- as.integer(temp[5])
- }
- object@mykey[mykey] = as.integer(mykey-1)
- object@sumtype[mykey] = as.integer(sumtype)
- object@first_orig[mykey] = start
- object@last_orig[mykey] = end
- object@outfile[mykey] = temp[6]
- if(object@sumtype[mykey] != 0) {
- object@use[mykey] = TRUE
- } else {
- object@use[mykey] = FALSE
- }
- }
- }
- return(object)
- })
+setMethod(
+ "swReadLines",
+ signature = c(object="swOUT",file="character"),
+ function(object,file) {
+ print("TODO: method 'swReadLines' for class 'swOUT' is not up-to-date; hard-coded indices are incorrect")
+
+ infiletext <- readLines(con = file)
+ if(temp<-strsplit(infiletext[41],split=" ")[[1]][2] == "t") {
+ object@outputSeparator="\t"
+ } else if(temp == "s") {
+ object@outputSeparator=" "
+ } else if(temp == "c"){
+ object@outputSeparator=","
+ } else {
+ object@outputSeparator="\t"
+ }
+
+ if (infiletext[42] == "") {
+ useTimeStep = FALSE
+ } else {
+ useTimeStep = TRUE
+ temp<-strsplit(x=infiletext[42], split=" ")[[1]][-1]
+ object@timeSteps = as.integer(
+ sapply(
+ 1:length(temp),
+ FUN=function(i) which(temp[i] == timePeriods)
+ )-1
+ )
+ }
+
+ for(i in 45:length(infiletext)) {
+ if(infiletext[i] != "") {
+ temp<-strsplit(x=infiletext[i],split="\t")[[1]]
+ temp<-unlist(strsplit(x=temp,split=" "))
+ temp <- temp[temp != ""][1:6]
+ mykey<- as.integer(grep(pattern=temp[1],x=KEY)[1])
+ sumtype <- as.integer(grep(pattern=temp[2],x=OutSum))-1
+ period <- which(tolower(temp[3]) == timePeriods)-1
+ start <- as.integer(temp[4])
+ if(grepl(pattern="end",x=temp[5])) {
+ end <- as.integer(366)
+ } else {
+ end <- as.integer(temp[5])
+ }
+ object@mykey[mykey] = as.integer(mykey-1)
+ object@sumtype[mykey] = as.integer(sumtype)
+ object@first_orig[mykey] = start
+ object@last_orig[mykey] = end
+ object@outfile[mykey] = temp[6]
+ if(object@sumtype[mykey] != 0) {
+ object@use[mykey] = TRUE
+ } else {
+ object@use[mykey] = FALSE
+ }
+ }
+ }
+ return(object)
+ }
+)
# nolint end
diff --git a/R/H_swSWC.R b/R/H_swSWC.R
index 73aa6182..d68eb205 100644
--- a/R/H_swSWC.R
+++ b/R/H_swSWC.R
@@ -29,58 +29,71 @@
#'
#'
#' @param object An object of class \code{\linkS4class{swSWC_hist}}.
-#' @param .Object An object of class \code{\linkS4class{swSWC_hist}}.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
-#' @param year An integer value. The calendar year of the \var{SWC}
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
+#' @slot year An integer value. The calendar year of the \var{SWC}
#' \code{data} object.
-#' @param data A 365 x 4 or 366 x 4 matrix representing daily \var{SWC}
+#' @slot data A 365 x 4 or 366 x 4 matrix representing daily \var{SWC}
#' data for one calendar \code{year} with columns \var{doy}, \var{lyr},
#' \var{swc}, \var{st_err}.
#'
#' @name swSWC_hist-class
#' @export
-setClass("swSWC_hist", slot = c(data = "matrix", year = "integer"))
+setClass(
+ "swSWC_hist",
+ slot = c(data = "matrix", year = "integer"),
+ prototype = list(
+ data = array(
+ NA_real_,
+ dim = c(366, 4),
+ dimnames = list(NULL, c("doy", "lyr", "swc", "st_err"))
+ ),
+ year = NA_integer_
+ )
+)
#' @rdname swSWC_hist-class
#' @export
-setMethod("initialize", signature = "swSWC_hist",
- function(.Object, ..., year = 0L, data = NULL) {
- # We don't set values; this is to prevent simulation runs with
- # accidentally incorrect values
-
- # We have to explicitly give column names (as defined in
- # `onGet_SW_SWC_hist`) because they are not read in by C code if the
- # historical soil moisture data are not provided as input
- ctemp <- c("doy", "lyr", "swc", "st_err")
- if (is.null(data)) {
- data <- matrix(NA_real_, nrow = 366, ncol = length(ctemp))
- data[, "doy"] <- 1:366
- }
- colnames(data) <- ctemp
- .Object@data <- data
-
- .Object@year <- as.integer(year)
+swSWC_hist <- function(...) {
+ def <- new("swSWC_hist")
+ sns <- slotNames("swSWC_hist")
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swSWC_hist")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
+ dns <- names(dots)
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ # We don't set values; this is to prevent simulation runs with
+ # accidentally incorrect values
- validObject(.Object)
- .Object
-})
+ # Use prototype "def", but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+ do.call("new", args = c("swSWC_hist", tmp))
+}
#' @rdname swSWC_hist-class
#' @export
# nolint start
-setMethod("swReadLines",
+setMethod(
+ "swReadLines",
signature = c(object = "swSWC_hist", file = "character"),
function(object, file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
+ stop("swReadLines is defunct.")
object@year <- as.integer(strsplit(x = file, split = ".",
fixed = TRUE)[[1]][2])
infiletext <- readLines(con = file)
@@ -105,10 +118,16 @@ setMethod("swReadLines",
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swSWC}}.
-#' @param .Object An object of class \code{\linkS4class{swSWC}}.
#' @param file A character string. The file name from which to read.
#' @param value A value to assign to a specific slot of the object.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#' @param year An integer value. The calendar year of the \var{SWC}
#' \code{data} object.
#'
@@ -122,42 +141,57 @@ setMethod("swReadLines",
#' @examples
#' showClass("swSWC")
#' x <- new("swSWC")
+#' x <- swSWC()
#'
#' @name swSWC-class
#' @export
-setClass("swSWC", slot = c(UseSWCHistoricData = "logical",
- DataFilePrefix = "character", FirstYear = "integer", Method = "integer",
- History = "list"))
+setClass(
+ "swSWC",
+ slot = c(
+ UseSWCHistoricData = "logical",
+ DataFilePrefix = "character",
+ FirstYear = "integer",
+ Method = "integer",
+ History = "list"
+ ),
+ prototype = list(
+ UseSWCHistoricData = NA,
+ DataFilePrefix = NA_character_,
+ FirstYear = NA_integer_,
+ Method = NA_integer_,
+ History = list()
+ )
+)
#' @rdname swSWC-class
#' @export
-setMethod("initialize", signature = "swSWC", function(.Object, ...) {
+swSWC <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "swc")
- sns <- slotNames(def)
+ sns <- slotNames("swSWC")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swSWC")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
+
# We don't set values for slot `History` if not passed via ...; this
# is to prevent simulation runs with accidentally incorrect values
if (!("History" %in% dns)) {
def@History <- list()
- } else {
- # Guarantee dimnames
- dimnames(dots[["History"]]) <- dimnames(def@History)
}
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
- }
+ do.call("new", args = c("swSWC", tmp))
+}
- validObject(.Object)
- .Object
-})
#' @rdname swSWC-class
#' @export
@@ -181,71 +215,87 @@ setMethod("swSWC_HistoricList", "swSWC", function(object) object@History)
#' @rdname swSWC-class
#' @export
-setMethod("swSWC_HistoricData", "swSWC", function(object, year) {
- index <- which(names(object@History) == as.character(year))
- if (length(index) != 1) {
- print("swc historic data Index has wrong length.")
- return(NULL)
- }
- if (object@History[[index]]@year != as.integer(year))
- print("Somethings wrong with the historical soil moisture data.")
+setMethod(
+ "swSWC_HistoricData",
+ "swSWC",
+ function(object, year) {
+ index <- which(names(object@History) == as.character(year))
+ if (length(index) != 1) {
+ print("swc historic data Index has wrong length.")
+ return(NULL)
+ }
+ if (object@History[[index]]@year != as.integer(year)) {
+ print("Somethings wrong with the historical soil moisture data.")
+ }
- object@History[[index]]
-})
+ object@History[[index]]
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_use",
+setReplaceMethod(
+ "swSWC_use",
signature = c(object = "swSWC", value = "logical"),
function(object, value) {
object@UseSWCHistoricData[] <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_prefix",
+setReplaceMethod(
+ "swSWC_prefix",
signature = c(object = "swSWC", value = "character"),
function(object, value) {
object@DataFilePrefix <- as.character(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_FirstYear",
+setReplaceMethod(
+ "swSWC_FirstYear",
signature = c(object = "swSWC", value = "integer"),
function(object, value) {
object@FirstYear <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_Method",
+setReplaceMethod(
+ "swSWC_Method",
signature = c(object = "swSWC", value = "integer"),
function(object, value) {
object@Method <- as.integer(value)
validObject(object)
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_HistoricList",
+setReplaceMethod(
+ "swSWC_HistoricList",
signature = c(object = "swSWC", value = "list"),
function(object, value) {
object@History <- value
validObject(object)
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
-setReplaceMethod("swSWC_HistoricData",
+setReplaceMethod(
+ "swSWC_HistoricData",
signature = c(object = "swSWC", value = "swSWC_hist"),
function(object, value) {
index <- which(names(object@History) == as.character(value@year))
@@ -266,15 +316,18 @@ setReplaceMethod("swSWC_HistoricData",
}
object
-})
+ }
+)
#' @rdname swSWC-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object = "swSWC", file = "character"),
+setMethod(
+ "swReadLines",
+ signature = c(object = "swSWC", file = "character"),
function(object, file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
+ stop("swReadLines is defunct")
infiletext <- readLines(con = file)
#should be no empty lines
infiletext <- infiletext[infiletext != ""]
@@ -283,5 +336,6 @@ setMethod("swReadLines", signature = c(object = "swSWC", file = "character"),
object@FirstYear <- readInteger(infiletext[6])
object@Method <- readInteger(infiletext[7])
return(object)
-})
+ }
+)
# nolint end
diff --git a/R/I_swEstab.R b/R/I_swEstab.R
index c9fee11c..60e0197b 100644
--- a/R/I_swEstab.R
+++ b/R/I_swEstab.R
@@ -28,9 +28,15 @@
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swEstabSpecies}}.
-#' @param .Object An object of class \code{\linkS4class{swEstabSpecies}}.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -42,71 +48,132 @@
#' @examples
#' showClass("swEstabSpecies")
#' x <- new("swEstabSpecies")
+#' x <- swEstabSpecies()
#'
#' @name swEstabSpecies-class
#' @export
-setClass("swEstabSpecies", slot = c(fileName = "character", Name = "character",
- vegType = "integer",
- estab_lyrs = "integer", barsGERM = "numeric", barsESTAB = "numeric",
- min_pregerm_days = "integer", max_pregerm_days = "integer",
- min_wetdays_for_germ = "integer", max_drydays_postgerm = "integer",
- min_wetdays_for_estab = "integer", min_days_germ2estab = "integer",
- max_days_germ2estab = "integer", min_temp_germ = "numeric",
- max_temp_germ = "numeric", min_temp_estab = "numeric",
- max_temp_estab = "numeric"))
-
-setValidity("swEstabSpecies", function(object) {
- TRUE
-})
+setClass(
+ "swEstabSpecies",
+ slot = c(
+ fileName = "character",
+ Name = "character",
+ vegType = "integer",
+ estab_lyrs = "integer",
+ barsGERM = "numeric",
+ barsESTAB = "numeric",
+ min_pregerm_days = "integer",
+ max_pregerm_days = "integer",
+ min_wetdays_for_germ = "integer",
+ max_drydays_postgerm = "integer",
+ min_wetdays_for_estab = "integer",
+ min_days_germ2estab = "integer",
+ max_days_germ2estab = "integer",
+ min_temp_germ = "numeric",
+ max_temp_germ = "numeric",
+ min_temp_estab = "numeric",
+ max_temp_estab = "numeric"
+ ),
+ prototype = list(
+ fileName = character(),
+ Name = character(),
+ vegType = integer(),
+ estab_lyrs = integer(),
+ barsGERM = numeric(),
+ barsESTAB = numeric(),
+ min_pregerm_days = integer(),
+ max_pregerm_days = integer(),
+ min_wetdays_for_germ = integer(),
+ max_drydays_postgerm = integer(),
+ min_wetdays_for_estab = integer(),
+ min_days_germ2estab = integer(),
+ max_days_germ2estab = integer(),
+ min_temp_germ = numeric(),
+ max_temp_germ = numeric(),
+ min_temp_estab = numeric(),
+ max_temp_estab = numeric()
+ )
+
+)
+
+setValidity(
+ "swEstabSpecies",
+ function(object) TRUE
+)
#' @rdname swEstabSpecies-class
#' @export
-setMethod("initialize", signature = "swEstabSpecies", function(.Object, ...) {
+swEstabSpecies <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "estab")
sns <- slotNames("swEstabSpecies")
dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swEstabSpecies")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
dns <- names(dots)
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
- }
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
+
+ do.call("new", args = c("swEstabSpecies", tmp))
+}
+
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swEstabSpecies",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swEstabSpecies`.")
+ }
+ object <- suppressWarnings(swEstabSpecies(object))
+ }
+
+ object
}
+)
- validObject(.Object)
- .Object
-})
#' @rdname swEstabSpecies-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object="swEstabSpecies",file="character"), function(object,file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
- infiletext <- readLines(con = file)
-
- object@Name = c(object@Name, gsub("[[:space:]]", "",strsplit(x=infiletext[1],split = c("#", " ", "\t"),fixed=F)[[1]][1]))
- object@estab_lyrs = c(object@estab_lyrs,readInteger(infiletext[3]))
- object@barsGERM = c(object@barsGERM,readNumeric(infiletext[4]))
- object@barsESTAB = c(object@barsESTAB,readNumeric(infiletext[5]))
- object@min_pregerm_days = c(object@min_pregerm_days,readInteger(infiletext[7]))
- object@max_pregerm_days = c(object@max_pregerm_days,readInteger(infiletext[8]))
- object@min_wetdays_for_germ = c(object@min_wetdays_for_germ,readInteger(infiletext[9]))
- object@max_drydays_postgerm = c(object@max_drydays_postgerm,readInteger(infiletext[10]))
- object@min_wetdays_for_estab = c(object@min_wetdays_for_estab,readInteger(infiletext[11]))
- object@min_days_germ2estab = c(object@min_days_germ2estab,readInteger(infiletext[12]))
- object@max_days_germ2estab = c(object@max_days_germ2estab,readInteger(infiletext[13]))
- object@min_temp_germ = c(object@min_temp_germ,readInteger(infiletext[15]))
- object@max_temp_germ = c(object@max_temp_germ,readNumeric(infiletext[16]))
- object@min_temp_estab = c(object@min_temp_estab,readNumeric(infiletext[17]))
- object@max_temp_estab = c(object@max_temp_estab,readNumeric(infiletext[18]))
- return(object)
- })
+setMethod(
+ "swReadLines",
+ signature = c(object="swEstabSpecies",file="character"),
+ function(object,file) {
+ stop("swReadLines is defunct")
+ infiletext <- readLines(con = file)
+
+ object@Name = c(object@Name, gsub("[[:space:]]", "",strsplit(x=infiletext[1],split = c("#", " ", "\t"),fixed=F)[[1]][1]))
+ object@estab_lyrs = c(object@estab_lyrs,readInteger(infiletext[3]))
+ object@barsGERM = c(object@barsGERM,readNumeric(infiletext[4]))
+ object@barsESTAB = c(object@barsESTAB,readNumeric(infiletext[5]))
+ object@min_pregerm_days = c(object@min_pregerm_days,readInteger(infiletext[7]))
+ object@max_pregerm_days = c(object@max_pregerm_days,readInteger(infiletext[8]))
+ object@min_wetdays_for_germ = c(object@min_wetdays_for_germ,readInteger(infiletext[9]))
+ object@max_drydays_postgerm = c(object@max_drydays_postgerm,readInteger(infiletext[10]))
+ object@min_wetdays_for_estab = c(object@min_wetdays_for_estab,readInteger(infiletext[11]))
+ object@min_days_germ2estab = c(object@min_days_germ2estab,readInteger(infiletext[12]))
+ object@max_days_germ2estab = c(object@max_days_germ2estab,readInteger(infiletext[13]))
+ object@min_temp_germ = c(object@min_temp_germ,readInteger(infiletext[15]))
+ object@max_temp_germ = c(object@max_temp_germ,readNumeric(infiletext[16]))
+ object@min_temp_estab = c(object@min_temp_estab,readNumeric(infiletext[17]))
+ object@max_temp_estab = c(object@max_temp_estab,readNumeric(infiletext[18]))
+ return(object)
+ }
+)
# nolint end
+
#############################ESTAB.IN#########################################
#' Class \code{"swEstab"}
#'
@@ -114,10 +181,16 @@ setMethod("swReadLines", signature = c(object="swEstabSpecies",file="character")
#' \code{\linkS4class{swInputData}}.
#'
#' @param object An object of class \code{\linkS4class{swEstab}}.
-#' @param .Object An object of class \code{\linkS4class{swEstab}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -129,69 +202,119 @@ setMethod("swReadLines", signature = c(object="swEstabSpecies",file="character")
#' @examples
#' showClass("swEstab")
#' x <- new("swEstab")
+#' x <- swEstab()
#'
#' @name swEstab-class
#' @export
-setClass("swEstab", slot = c(useEstab = "logical", count = "integer"),
- contains = "swEstabSpecies")
+setClass(
+ "swEstab",
+ slot = c(useEstab = "logical", count = "integer"),
+ contains = "swEstabSpecies",
+ prototype = list(
+ useEstab = NA,
+ count = integer()
+ )
+)
+
+setValidity(
+ "swEstab",
+ function(object) TRUE
+)
-setValidity("swEstab", function(object) {
- TRUE
-})
#' @rdname swEstab-class
#' @export
-setMethod("initialize", signature = "swEstab", function(.Object, ...) {
+swEstab <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "estab")
sns <- setdiff(slotNames("swEstab"), inheritedSlotNames("swEstab"))
dots <- list(...)
- dns <- names(dots)
-
- for (sn in sns) {
- slot(.Object, sn) <- if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ if (length(dots) == 1 && inherits(dots[[1]], "swEstab")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
}
+ dns <- setdiff(names(dots), inheritedSlotNames("swEstab"))
- .Object <- callNextMethod(.Object, ...)
- validObject(.Object)
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- .Object
-})
+ do.call(
+ "new",
+ args = c(
+ "swEstab",
+ if ("swEstabSpecies" %in% dns) {
+ swEstabSpecies(dots[["swEstabSpecies"]])
+ } else {
+ do.call(swEstabSpecies, dots)
+ },
+ tmp
+ )
+ )
+}
#' @rdname swEstab-class
#' @export
setMethod("swEstab_useEstab", "swEstab", function(object) object@useEstab)
+
#' @rdname swEstab-class
#' @export
-setReplaceMethod("swEstab_useEstab", signature = "swEstab",
+setReplaceMethod(
+ "swEstab_useEstab",
+ signature = "swEstab",
function(object, value) {
object@useEstab <- as.logical(value)
validObject(object)
object
-})
+ }
+)
+
+#' @rdname sw_upgrade
+setMethod(
+ "sw_upgrade",
+ signature = "swEstab",
+ definition = function(object, verbose = FALSE) {
+ tmp <- try(validObject(object), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ if (verbose) {
+ message("Upgrading object of class `swEstab`.")
+ }
+ object <- suppressWarnings(swEstab(object))
+ }
+
+ object
+ }
+)
+
#' @rdname swEstab-class
#' @export
# nolint start
-setMethod("swReadLines", signature = c(object="swEstab",file="character"), function(object,file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
- infiletext <- readLines(con = file[1])
- index<-length(object@fileName)+1
- object@useEstab = readLogical(infiletext[9])
- object@count = 0L
- if(object@useEstab) {
- infiletext <- infiletext[-c(1:9)]
- infiletext <- infiletext[infiletext != ""]
- for(i in 1:length(infiletext)) {
- #see if the line is commented out
- line<-gsub("[[:space:]]", "",strsplit(x=infiletext[i],split=c("#"))[[1]][1])
- if(line != "") {
- object@fileName <- c(object@fileName, line)
- object@count <- object@count + 1L
- as(object,"swEstabSpecies") <- swReadLines(as(object,"swEstabSpecies"),file.path(file[2],line))
- }
- }
- }
- return(object)
- })
+setMethod(
+ "swReadLines",
+ signature = c(object="swEstab",file="character"),
+ function(object,file) {
+ stop("swReadLines is defunct")
+ infiletext <- readLines(con = file[1])
+ index<-length(object@fileName)+1
+ object@useEstab = readLogical(infiletext[9])
+ object@count = 0L
+ if(object@useEstab) {
+ infiletext <- infiletext[-c(1:9)]
+ infiletext <- infiletext[infiletext != ""]
+ for(i in 1:length(infiletext)) {
+ #see if the line is commented out
+ line<-gsub("[[:space:]]", "",strsplit(x=infiletext[i],split=c("#"))[[1]][1])
+ if(line != "") {
+ object@fileName <- c(object@fileName, line)
+ object@count <- object@count + 1L
+ as(object,"swEstabSpecies") <- swReadLines(as(object,"swEstabSpecies"),file.path(file[2],line))
+ }
+ }
+ }
+ return(object)
+ })
# nolint end
diff --git a/R/J_swLog.R b/R/J_swLog.R
index 9be9e21e..51944799 100644
--- a/R/J_swLog.R
+++ b/R/J_swLog.R
@@ -29,8 +29,14 @@
#' The methods listed below work on this class and the proper slot of the class
#' \code{\linkS4class{swInputData}}.
#'
-#' @param .Object An object of class \code{\linkS4class{swLog}}.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#'
#' @seealso \code{\linkS4class{swInputData}} \code{\linkS4class{swFiles}}
#' \code{\linkS4class{swWeather}} \code{\linkS4class{swCloud}}
@@ -42,29 +48,51 @@
#' @examples
#' showClass("swLog")
#' x <- new("swLog")
+#' x <- swLog()
#'
#' @name swLog-class
#' @export
-setClass("swLog", slot = c(LogData = "character", MaxLines = "integer",
- UsedLines = "integer"))
+setClass(
+ "swLog",
+ slot = c(LogData = "character", MaxLines = "integer", UsedLines = "integer"),
+ prototype = c(
+ LogData = NA_character_,
+ MaxLines = NA_integer_,
+ UsedLines = NA_integer_
+ )
+)
#' @rdname swLog-class
#' @export
-setMethod("initialize", signature = "swLog", function(.Object, ...) {
+swLog <- function(...) {
def <- slot(rSOILWAT2::sw_exampleData, "log")
+ sns <- slotNames("swLog")
+ dots <- list(...)
+ if (length(dots) == 1 && inherits(dots[[1]], "swLog")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
+ dns <- names(dots)
# We don't set values for any slots; this is to prevent simulation runs with
# accidentally incorrect values
- .Object@MaxLines <- 150L
- .Object@LogData <- character(.Object@MaxLines)
- .Object@UsedLines <- 1L
-
- if (FALSE) {
- # not needed because no relevant inheritance
- .Object <- callNextMethod(.Object, ...)
+ if (!("MaxLines" %in% dns)) {
+ dots[["MaxLines"]] <- 150L
+ }
+ if (!("LogData" %in% dns)) {
+ dots[["LogData"]] <- character(dots[["MaxLines"]])
}
+ if (!("UsedLines" %in% dns)) {
+ dots[["UsedLines"]] <- 1L
+ }
+
+ # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence
+ tmp <- lapply(
+ sns,
+ function(sn) if (sn %in% dns) dots[[sn]] else slot(def, sn)
+ )
+ names(tmp) <- sns
- validObject(.Object)
- .Object
-})
+ do.call("new", args = c("swLog", tmp))
+}
diff --git a/R/K_swContainer.R b/R/K_swContainer.R
index 99b074c7..825543c9 100644
--- a/R/K_swContainer.R
+++ b/R/K_swContainer.R
@@ -29,7 +29,7 @@
#'
#' \code{\linkS4class{swInputData}} consists of slots for each file that is
#' read in. These slots can be accessed via the following functions: \itemize{
-#' \item \code{\link{get_Markov}}
+#' \item \code{\link{get_swMarkov}}
#' \item \code{\link{get_swCloud}}
#' \item \code{\link{get_swFiles}}
#' \item \code{\link{get_swOUT}}
@@ -51,10 +51,16 @@
#' }
#'
#' @param object An object of class \code{\linkS4class{swInputData}}.
-#' @param .Object An object of class \code{\linkS4class{swInputData}}.
#' @param value A value to assign to a specific slot of the object.
#' @param file A character string. The file name from which to read.
-#' @param ... Further arguments to methods.
+#' @param ... Arguments to the helper constructor function.
+#' Dots can either contain objects to copy into slots of that class
+#' (must be named identical to the corresponding slot) or
+#' be one object of that class (in which case it will be copied and
+#' any missing slots will take their default values).
+#' If dots are missing, then corresponding values of
+#' \code{rSOILWAT2::sw_exampleData}
+#' (i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.
#' @param year An integer value. The calendar year of the weather or
#' \var{SWC} \code{data} object.
#' @param vegtype The name or index of the vegetation type.
@@ -69,7 +75,8 @@
#'
#' @examples
#' showClass("swInputData")
-#' x <- new("swInputData")
+#' x <- new("swInputData") # prototype
+#' x <- swInputData() # constructor helper
#'
#' @name swInputData-class
#' @export
@@ -93,62 +100,189 @@ setClass(
swc = "swSWC",
log = "swLog"
)
+ # Note: we cannot set prototypes for `swInputData` because
+ # that calls each slot's class constructor; the constructors call eventually
+ # `new()` which in turn calls setValidity()` which use `rSW2_glovars`.
+ # However, this all occurs before `rSW2_glovars` is defined, i.e.,
+ # validity functions are erroring out if they utilize `rSW2_glovars`.
+ # Calling `validObject()` at run time is not a problem because
+ # `rSW2_glovars` will be defined by then (see `.onLoad()`).
)
#' @rdname swInputData-class
#' @export
-setMethod(
- "initialize",
- signature = "swInputData",
- function(.Object) {
- sns <- slotNames("swInputData")
- scl <- getSlots("swInputData")
+swInputData <- function(...) {
+ # Call helper constructor for each slot class
+ dots <- list(...)
- for (i in seq_along(sns)) {
- slot(.Object, sns[i]) <- new(scl[i])
- }
+ if (length(dots) == 1 && inherits(dots[[1]], "swInputData")) {
+ # If dots are one object of this class, then convert to list of its slots
+ dots <- attributes(unclass(dots[[1]]))
+ }
+
+ dns <- names(dots)
- slot(.Object, "version") <- rSW2_version()
- slot(.Object, "timestamp") <- rSW2_timestamp()
+ object <- new("swInputData")
+ object@version <- rSW2_version()
+ object@timestamp <- rSW2_timestamp()
- validObject(.Object)
- .Object
+ object@files <- if ("files" %in% dns) {
+ swFiles(dots[["files"]])
+ } else {
+ do.call(swFiles, dots)
}
-)
-setValidity(
- "swInputData",
- function(object) {
- TRUE
+ object@years <- if ("years" %in% dns) {
+ swYears(dots[["years"]])
+ } else {
+ do.call(swYears, dots)
+ }
+
+ object@weather <- if ("weather" %in% dns) {
+ swWeather(dots[["weather"]])
+ } else {
+ do.call(swWeather, dots)
}
-)
+ object@cloud <- if ("cloud" %in% dns) {
+ swCloud(dots[["cloud"]])
+ } else {
+ do.call(swCloud, dots)
+ }
+ object@weatherHistory <- weatherHistory(dots[["weatherHistory"]])
+ object@markov <- if ("markov" %in% dns) {
+ swMarkov(dots[["markov"]])
+ } else {
+ do.call(swMarkov, dots)
+ }
-#' @rdname get_version
-setMethod(
- f = "get_version",
- signature = "swInputData",
- definition = function(object) {
- tmp <- try(object@version, silent = TRUE)
- if (inherits(tmp, "try-error")) NA else tmp
+ object@prod <- if ("prod" %in% dns) {
+ swProd(dots[["prod"]])
+ } else {
+ do.call(swProd, dots)
+ }
+
+ object@site <- if ("site" %in% dns) {
+ swSite(dots[["site"]])
+ } else {
+ do.call(swSite, dots)
+ }
+
+ object@soils <- if ("soils" %in% dns) {
+ swSoils(dots[["soils"]])
+ } else {
+ do.call(swSoils, dots)
+ }
+
+ object@estab <- if ("estab" %in% dns) {
+ swEstab(dots[["estab"]])
+ } else {
+ do.call(swEstab, dots)
+ }
+
+ object@carbon <- if ("carbon" %in% dns) {
+ swCarbon(dots[["carbon"]])
+ } else {
+ do.call(swCarbon, dots)
+ }
+
+ object@output <- if ("output" %in% dns) {
+ swOUT(dots[["output"]])
+ } else {
+ do.call(swOUT, dots)
+ }
+
+ object@swc <- if ("swc" %in% dns) {
+ swSWC(dots[["swc"]])
+ } else {
+ do.call(swSWC, dots)
+ }
+
+ object@log <- if ("log" %in% dns) {
+ swLog(dots[["log"]])
+ } else {
+ do.call(swLog, dots)
+ }
+
+ object
+}
+
+
+
+setValidity(
+ "swInputData",
+ function(object) {
+ res <- lapply(slotNames(object), function(sn) validObject(slot(object, sn)))
+ has_msg <- sapply(res, is.character)
+ if (any(has_msg)) {
+ unlist(res[has_msg])
+ } else {
+ TRUE
+ }
}
)
-#' @rdname get_timestamp
+
+#' @rdname sw_upgrade
+#' @export
setMethod(
- f = "get_timestamp",
+ "sw_upgrade",
signature = "swInputData",
- definition = function(object) {
- tmp <- try(object@timestamp, silent = TRUE)
- if (inherits(tmp, "try-error")) NA else tmp
+ definition = function(object, verbose = FALSE) {
+
+ msg_upgrades <- NULL
+
+ # Suppress warnings in case `object` is indeed invalid (outdated)
+ if (!suppressWarnings(check_version(object))) {
+
+ for (sn in slotNames(object)) {
+ if (identical(sn, "weatherHistory")) {
+ if (!dbW_check_weatherData(slot(object, sn), check_all = FALSE)) {
+ slot(object, sn) <- suppressWarnings(
+ upgrade_weatherHistory(slot(object, sn))
+ )
+ msg_upgrades <- c(msg_upgrades, sn)
+ }
+
+ } else {
+ tmp <- try(validObject(slot(object, sn)), silent = TRUE)
+ if (inherits(tmp, "try-error")) {
+ slot(object, sn) <- suppressWarnings(
+ sw_upgrade(slot(object, sn), verbose = FALSE)
+ )
+ msg_upgrades <- c(msg_upgrades, sn)
+ }
+ }
+ }
+
+ if (length(msg_upgrades) > 0) {
+ if (verbose) {
+ message(
+ "Upgrading object of class `swInputData`: ",
+ toString(shQuote(msg_upgrades))
+ )
+ }
+
+ #--- Update version/timestamp
+ object@version <- rSW2_version()
+ object@timestamp <- rSW2_timestamp()
+
+ #--- Check validity and return
+ validObject(object)
+ }
+ }
+
+ object
}
)
+
+
# Methods for slot \code{files}
#' @rdname swInputData-class
#' @export
@@ -202,6 +336,14 @@ setMethod(
function(object) swFiles_Soils(object@files)
)
+#' @rdname swInputData-class
+#' @export
+setMethod(
+ "swFiles_SWRCp",
+ signature = "swInputData",
+ function(object) swFiles_SWRCp(object@files)
+)
+
#' @rdname swInputData-class
#' @export
setMethod(
@@ -369,6 +511,17 @@ setReplaceMethod(
}
)
+#' @rdname swInputData-class
+#' @export
+setReplaceMethod(
+ "swFiles_SWRCp",
+ signature = "swInputData",
+ function(object, value) {
+ swFiles_SWRCp(object@files) <- value
+ object
+ }
+)
+
#' @rdname swInputData-class
#' @export
setReplaceMethod(
@@ -905,10 +1058,15 @@ setReplaceMethod(
# Methods for slot \code{markov}
+# use `get_swMarkov()`, `get_Markov()` is a legacy name
#' @rdname swInputData-class
#' @export
setMethod("get_Markov", "swInputData", function(object) object@markov)
+#' @rdname swInputData-class
+#' @export
+setMethod("get_swMarkov", "swInputData", function(object) object@markov)
+
#' @rdname swInputData-class
#' @export
setMethod(
@@ -926,13 +1084,25 @@ setMethod(
)
+# use `set_swMarkov()`; `set_Markov()` is a legacy name
#' @rdname swInputData-class
#' @export
setReplaceMethod(
"set_Markov",
signature = "swInputData",
function(object, value) {
- set_Markov(object@markov) <- value
+ set_swMarkov(object@markov) <- value
+ object
+ }
+)
+
+#' @rdname swInputData-class
+#' @export
+setReplaceMethod(
+ "set_swMarkov",
+ signature = "swInputData",
+ function(object, value) {
+ set_swMarkov(object@markov) <- value
object
}
)
@@ -1418,11 +1588,32 @@ setReplaceMethod(
)
+# Methods for slot \code{estab}
+#' @rdname swInputData-class
+#' @export
+setMethod("get_swEstab", "swInputData", function(object) object@estab)
+
+
# Methods for slot \code{site}
#' @rdname swInputData-class
#' @export
setMethod("get_swSite", "swInputData", function(object) slot(object, "site"))
+#' @rdname swSite_SWRCflags
+setMethod(
+ "swSite_SWRCflags",
+ signature = "swInputData",
+ function(object) swSite_SWRCflags(object@site)
+)
+
+#' @rdname swSite_hasSWRCp
+setMethod(
+ "swSite_hasSWRCp",
+ signature = "swInputData",
+ function(object) swSite_hasSWRCp(object@site)
+)
+
+
#' @rdname swInputData-class
#' @export
setMethod(
@@ -1503,6 +1694,14 @@ setMethod(
function(object) swSite_SoilTemperatureConsts(object@site)
)
+#' @rdname swInputData-class
+#' @export
+setMethod(
+ "swSite_SoilDensityInputType",
+ signature = "swInputData",
+ function(object) swSite_SoilDensityInputType(object@site)
+)
+
#' @rdname swInputData-class
#' @export
setMethod(
@@ -1523,6 +1722,45 @@ setReplaceMethod(
}
)
+#' @rdname swSite_SWRCflags
+#'
+#' @section Details:
+#' The replacement method [swSite_SWRCflags()] for class [swInputData-class]
+#' resets `has_swrcp` to `FALSE` if `"swrc_name"` or `"ptf_name"` are updated.
+#' This is to avoid inconsistency between
+#' `SWRCp`, `has_swrcp`, and `swrc_flags`.
+#'
+#' @section Details:
+#' The correct sequence for setting values is
+#' 1. [swSoils_Layers()],
+#' 2. [swSite_SWRCflags()], and
+#' 3. [swSoils_SWRCp()] and [swSite_hasSWRCp()]
+#'
+#' @md
+setReplaceMethod(
+ "swSite_SWRCflags",
+ signature = "swInputData",
+ function(object, value) {
+ prev <- as.character(swSite_SWRCflags(object@site))
+ value <- as.character(value)
+ if (!identical(prev, value)) {
+ swSite_SWRCflags(object@site) <- value
+ # Reset has_swrcp -- avoid inconsistency between SWRCp and swrc_flags
+ swSite_hasSWRCp(object) <- FALSE
+ }
+ object
+ }
+)
+
+#' @rdname swSite_hasSWRCp
+setReplaceMethod(
+ "swSite_hasSWRCp",
+ signature = "swInputData",
+ function(object, value) {
+ swSite_hasSWRCp(object@site) <- value
+ object
+ }
+)
#' @rdname swInputData-class
#' @export
setReplaceMethod(
@@ -1633,6 +1871,17 @@ setReplaceMethod(
}
)
+#' @rdname swInputData-class
+#' @export
+setReplaceMethod(
+ "swSite_SoilDensityInputType",
+ signature = "swInputData",
+ function(object, value) {
+ swSite_SoilDensityInputType(object@site) <- value
+ object
+ }
+)
+
#' @rdname swInputData-class
#' @export
setReplaceMethod(
@@ -1650,14 +1899,20 @@ setReplaceMethod(
#' @export
setMethod("get_swSoils", "swInputData", function(object) object@soils)
-#' @rdname swInputData-class
-#' @export
+#' @rdname swSoils_Layers
setMethod(
"swSoils_Layers",
signature = "swInputData",
function(object) swSoils_Layers(object@soils)
)
+#' @rdname swSoils_SWRCp
+setMethod(
+ "swSoils_SWRCp",
+ signature = "swInputData",
+ function(object) swSoils_SWRCp(object@soils)
+)
+
#' @rdname swInputData-class
#' @export
setReplaceMethod(
@@ -1671,16 +1926,72 @@ setReplaceMethod(
#' @rdname swInputData-class
#' @export
+setReplaceMethod(
+ "set_swSoils",
+ signature = c(object = "swInputData", value = "list"),
+ function(object, value) {
+ set_swSoils(object@soils) <- value
+ object
+ }
+)
+
+#' @rdname swSoils_Layers
+#'
+#' @section Details:
+#' The replacement method `swSoils_Layers<-` for class [swInputData-class]
+#' resizes `SWRCp` to match number of new soil layers
+#' (and reset `SWRCp` values to `NA`) if `"has_swrcp"` is `FALSE`.
+#' This is to avoid inconsistency between
+#' soil properties and `SWRCp`.
+
+#'
+#' @section Details:
+#' The correct sequence for setting values is
+#' 1. [swSoils_Layers()],
+#' 2. [swSite_SWRCflags()], and
+#' 3. [swSoils_SWRCp()] and [swSite_hasSWRCp()]
+#'
+#' @md
setReplaceMethod(
"swSoils_Layers",
- signature = c(object = "swInputData", value = "matrix"),
+ signature = "swInputData",
function(object, value) {
+
+ if (!swSite_hasSWRCp(object@site)) {
+ # --> assigning new soil layers fails `swSoils` validity checks
+ # if number of soil layers disagrees with the SWRC parameter object.
+ object@soils@SWRCp <- reset_SWRCp(
+ SWRCp = object@soils@SWRCp,
+ new_nrow = nrow(value)
+ )
+ }
+
swSoils_Layers(object@soils) <- value
object
}
)
+#' @rdname swSoils_SWRCp
+#'
+#' @section Details:
+#' The correct sequence for setting values is
+#' 1. [swSoils_Layers()],
+#' 2. [swSite_SWRCflags()], and
+#' 3. [swSoils_SWRCp()] and [swSite_hasSWRCp()]
+#'
+#' @md
+setReplaceMethod(
+ "swSoils_SWRCp",
+ signature = "swInputData",
+ function(object, value) {
+ swSoils_SWRCp(object@soils) <- value
+ object
+ }
+)
+
+
+
# Methods for slot \code{swc}
#' @rdname swInputData-class
#' @export
@@ -2041,45 +2352,49 @@ setReplaceMethod(
object@log@LogData[object@log@UsedLines] <- value
object@log@UsedLines <- object@log@UsedLines + 1
}
-
+ validObject(object)
object
}
)
-##
+
#' @rdname swInputData-class
#' @export
# nolint start
-setMethod(f="swReadLines", signature = c(object="swInputData",file="character"), function(object,file) {
- print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
-
- object@files <- swReadLines(object@files,file)
- object@files@ProjDir <- dirname(file)
- object@years <- swReadLines(object@years,file.path(object@files@ProjDir, object@files@InFiles[2]))
- object@weather <- swReadLines(object@weather,file.path(object@files@ProjDir, object@files@InFiles[6]))
- weatherFiles <- list.files(path=file.path(object@files@ProjDir,dirname(object@files@WeatherPrefix)), pattern=basename(object@files@WeatherPrefix), include.dirs=F, recursive=F, full.names=T)
- object@weatherHistory <- list()
- if(length(weatherFiles) > 0) {
- for(i in 1:length(weatherFiles)) {
- wd <- new("swWeatherData",year=0)
- wd <- swReadLines(wd, weatherFiles[i])
- object@weatherHistory[[i]] <- wd
- }
- }
-
- object@cloud <- swReadLines(object@cloud,file.path(object@files@ProjDir, object@files@InFiles[9]))
- if(all(file.exists(file.path(object@files@ProjDir, object@files@InFiles[7:8]))))
- object@markov <- swReadLines(object@markov,file.path(object@files@ProjDir, object@files@InFiles[7:8]))
- object@prod <- swReadLines(object@prod,file.path(object@files@ProjDir, object@files@InFiles[10]))
- object@site <- swReadLines(object@site,file.path(object@files@ProjDir, object@files@InFiles[4]))
- object@soils <- swReadLines(object@soils,file.path(object@files@ProjDir, object@files@InFiles[5]))
- if(file.exists(file.path(object@files@ProjDir, object@files@InFiles[11]))) {#Optional File
- object@estab <- swReadLines(object@estab,c(file.path(object@files@ProjDir, object@files@InFiles[11]),object@files@ProjDir))
- }
- object@output <- swReadLines(object@output,file.path(object@files@ProjDir, object@files@InFiles[14]))
- object@swc <- swReadLines(object@swc,file.path(object@files@ProjDir, object@files@InFiles[13]))
- object@carbon <- swReadLines(object@carbon, file.path(object@files@ProjDir, object@files@InFiles[12]))
- return(object)
- })
+setMethod(
+ "swReadLines",
+ signature = c(object="swInputData",file="character"),
+ function(object,file) {
+ print("TODO: method 'swReadLines' for class 'swInputData' is not up-to-date; hard-coded indices are incorrect")
+
+ object@files <- swReadLines(object@files,file)
+ object@files@ProjDir <- dirname(file)
+ object@years <- swReadLines(object@years,file.path(object@files@ProjDir, object@files@InFiles[2]))
+ object@weather <- swReadLines(object@weather,file.path(object@files@ProjDir, object@files@InFiles[6]))
+ weatherFiles <- list.files(path=file.path(object@files@ProjDir,dirname(object@files@WeatherPrefix)), pattern=basename(object@files@WeatherPrefix), include.dirs=F, recursive=F, full.names=T)
+ object@weatherHistory <- list()
+ if(length(weatherFiles) > 0) {
+ for(i in 1:length(weatherFiles)) {
+ wd <- new("swWeatherData",year=0)
+ wd <- swReadLines(wd, weatherFiles[i])
+ object@weatherHistory[[i]] <- wd
+ }
+ }
+
+ object@cloud <- swReadLines(object@cloud,file.path(object@files@ProjDir, object@files@InFiles[9]))
+ if(all(file.exists(file.path(object@files@ProjDir, object@files@InFiles[7:8]))))
+ object@markov <- swReadLines(object@markov,file.path(object@files@ProjDir, object@files@InFiles[7:8]))
+ object@prod <- swReadLines(object@prod,file.path(object@files@ProjDir, object@files@InFiles[10]))
+ object@site <- swReadLines(object@site,file.path(object@files@ProjDir, object@files@InFiles[4]))
+ object@soils <- swReadLines(object@soils,file.path(object@files@ProjDir, object@files@InFiles[5]))
+ if(file.exists(file.path(object@files@ProjDir, object@files@InFiles[11]))) {#Optional File
+ object@estab <- swReadLines(object@estab,c(file.path(object@files@ProjDir, object@files@InFiles[11]),object@files@ProjDir))
+ }
+ object@output <- swReadLines(object@output,file.path(object@files@ProjDir, object@files@InFiles[14]))
+ object@swc <- swReadLines(object@swc,file.path(object@files@ProjDir, object@files@InFiles[13]))
+ object@carbon <- swReadLines(object@carbon, file.path(object@files@ProjDir, object@files@InFiles[12]))
+ return(object)
+ }
+)
# nolint end
diff --git a/R/L_swOutput.R b/R/L_swOutput.R
index c8299b17..e9aac806 100644
--- a/R/L_swOutput.R
+++ b/R/L_swOutput.R
@@ -22,45 +22,50 @@
###############################################################################
-# TODO: link this to C code
-# Note: the values must match those of rSW2_glovars[["kSOILWAT2"]][["OutKeys"]]
#' Slot names of \linkS4class{swOutput}
#' @return Standardized named vector for easier access to slots of class
#' \linkS4class{swOutput}.
#' @export
sw_out_flags <- function() {
- c(
- sw_aet = "AET",
- sw_deepdrain = "DEEPSWC",
- sw_estabs = "ESTABL",
- sw_evsoil = "EVAPSOIL",
- sw_evapsurface = "EVAPSURFACE",
- sw_frozen = "FROZEN",
- sw_hd = "HYDRED",
- sw_inf_soil = "SOILINFILT",
- sw_interception = "INTERCEPTION",
- sw_percolation = "LYRDRAIN",
- sw_pet = "PET",
- sw_precip = "PRECIP",
- sw_runoff = "RUNOFF",
- sw_snow = "SNOWPACK",
- sw_soiltemp = "SOILTEMP",
- sw_surfaceWater = "SURFACEWATER",
- sw_swp = "SWPMATRIC",
- sw_swabulk = "SWABULK",
- sw_swcbulk = "SWCBULK",
- sw_swa = "SWA",
- sw_temp = "TEMP",
- sw_transp = "TRANSP",
- sw_vwcbulk = "VWCBULK",
- sw_vwcmatric = "VWCMATRIC",
- sw_co2effects = "CO2EFFECTS",
- sw_veg = "BIOMASS",
- sw_wetdays = "WETDAY",
- sw_logfile = "LOG"
+ tmp <- rSW2_glovars[["kSOILWAT2"]][["OutKeys"]]
+ res <- c(
+ sw_aet = tmp["SW_AET"],
+ sw_deepdrain = tmp["SW_DEEPSWC"],
+ sw_estabs = tmp["SW_ESTAB"],
+ sw_evsoil = tmp["SW_EVAPSOIL"],
+ sw_evapsurface = tmp["SW_EVAPSURFACE"],
+ sw_frozen = tmp["SW_FROZEN"],
+ sw_hd = tmp["SW_HYDRED"],
+ sw_inf_soil = tmp["SW_SOILINF"],
+ sw_interception = tmp["SW_INTERCEPTION"],
+ sw_percolation = tmp["SW_LYRDRAIN"],
+ sw_pet = tmp["SW_PET"],
+ sw_precip = tmp["SW_PRECIP"],
+ sw_runoff = tmp["SW_RUNOFF"],
+ sw_snow = tmp["SW_SNOWPACK"],
+ sw_soiltemp = tmp["SW_SOILTEMP"],
+ sw_surfaceWater = tmp["SW_SURFACEW"],
+ sw_swp = tmp["SW_SWPMATRIC"],
+ sw_swabulk = tmp["SW_SWABULK"],
+ sw_swcbulk = tmp["SW_SWCBULK"],
+ sw_swa = tmp["SW_SWA"],
+ sw_temp = tmp["SW_TEMP"],
+ sw_transp = tmp["SW_TRANSP"],
+ sw_vwcbulk = tmp["SW_VWCBULK"],
+ sw_vwcmatric = tmp["SW_VWCMATRIC"],
+ sw_co2effects = tmp["SW_CO2EFFECTS"],
+ sw_veg = tmp["SW_BIOMASS"],
+ sw_wetdays = tmp["SW_WETDAY"]
)
+
+ # Fix names
+ tmp <- sapply(strsplit(names(res), split = ".", fixed = TRUE), `[`, j = 1)
+ names(res) <- tmp
+
+ res
}
+
###################Generic Class to Hold One Output KEY########################
#' Class \code{"swOutput_KEY"}
#'
@@ -84,7 +89,7 @@ sw_out_flags <- function() {
#'
#' @name swOutput_KEY-class
#' @export
-setClass(
+swOutput_KEY <- setClass(
"swOutput_KEY",
slot = c(
Title = "character",
@@ -94,6 +99,15 @@ setClass(
Week = "matrix",
Month = "matrix",
Year = "matrix"
+ ),
+ prototype = list(
+ Title = character(),
+ TimeStep = integer(),
+ Columns = integer(),
+ Day = matrix(NA_real_)[0, 0],
+ Week = matrix(NA_real_)[0, 0],
+ Month = matrix(NA_real_)[0, 0],
+ Year = matrix(NA_real_)[0, 0]
)
)
@@ -121,7 +135,7 @@ setMethod(
"swOutput_KEY_Period",
signature = "swOutput_KEY",
function(object, index) {
- slot(object, rSW2_glovars[["sw_TimeSteps"]][index])
+ slot(object, rSW2_glovars[["kSOILWAT2"]][["OutPeriods"]][index])
}
)
@@ -144,7 +158,7 @@ setReplaceMethod(
"swOutput_KEY_Period",
signature = "swOutput_KEY",
function(object, index, value) {
- slot(object, rSW2_glovars[["sw_TimeSteps"]][index]) <- value
+ slot(object, rSW2_glovars[["kSOILWAT2"]][["OutPeriods"]][index]) <- value
validObject(object)
object
}
@@ -176,7 +190,7 @@ setReplaceMethod(
#'
#' @name swOutput-class
#' @export
-setClass(
+swOutput <- setClass(
"swOutput",
slot = c(
version = "character",
@@ -217,26 +231,49 @@ setClass(
ESTABL = "swOutput_KEY",
CO2EFFECTS = "swOutput_KEY",
BIOMASS = "swOutput_KEY"
+ ),
+ prototype = list(
+ version = rSW2_version(),
+ timestamp = rSW2_timestamp(),
+ yr_nrow = integer(),
+ mo_nrow = integer(),
+ wk_nrow = integer(),
+ dy_nrow = integer(),
+ WTHR = swOutput_KEY(),
+ TEMP = swOutput_KEY(),
+ PRECIP = swOutput_KEY(),
+ SOILINFILT = swOutput_KEY(),
+ RUNOFF = swOutput_KEY(),
+ ALLH2O = swOutput_KEY(),
+ VWCBULK = swOutput_KEY(),
+ VWCMATRIC = swOutput_KEY(),
+ SWCBULK = swOutput_KEY(),
+ SWA = swOutput_KEY(),
+ SWABULK = swOutput_KEY(),
+ SWAMATRIC = swOutput_KEY(),
+ SWPMATRIC = swOutput_KEY(),
+ SURFACEWATER = swOutput_KEY(),
+ TRANSP = swOutput_KEY(),
+ EVAPSOIL = swOutput_KEY(),
+ EVAPSURFACE = swOutput_KEY(),
+ INTERCEPTION = swOutput_KEY(),
+ LYRDRAIN = swOutput_KEY(),
+ HYDRED = swOutput_KEY(),
+ ET = swOutput_KEY(),
+ AET = swOutput_KEY(),
+ PET = swOutput_KEY(),
+ WETDAY = swOutput_KEY(),
+ SNOWPACK = swOutput_KEY(),
+ DEEPSWC = swOutput_KEY(),
+ SOILTEMP = swOutput_KEY(),
+ ALLVEG = swOutput_KEY(),
+ ESTABL = swOutput_KEY(),
+ CO2EFFECTS = swOutput_KEY(),
+ BIOMASS = swOutput_KEY()
)
)
-#' @rdname swOutput-class
-#' @export
-setMethod(
- "initialize",
- signature = "swOutput",
- function(.Object) {
-
- slot(.Object, "version") <- rSW2_version()
- slot(.Object, "timestamp") <- rSW2_timestamp()
-
- validObject(.Object)
-
- .Object
- }
-)
-
setValidity(
"swOutput",
function(object) {
@@ -245,27 +282,6 @@ setValidity(
)
-#' @rdname get_version
-setMethod(
- f = "get_version",
- signature = "swOutput",
- definition = function(object) {
- tmp <- try(object@version, silent = TRUE)
- if (inherits(tmp, "try-error")) NA else tmp
- }
-)
-
-#' @rdname get_timestamp
-setMethod(
- f = "get_timestamp",
- signature = "swOutput",
- definition = function(object) {
- tmp <- try(object@timestamp, silent = TRUE)
- if (inherits(tmp, "try-error")) NA else tmp
- }
-)
-
-
#' @rdname swOutput-class
#' @export
setMethod("$", signature = "swOutput", function(x, name) slot(x, name))
diff --git a/R/Rsw.R b/R/Rsw.R
index ec6ce946..315eb5b8 100644
--- a/R/Rsw.R
+++ b/R/Rsw.R
@@ -35,6 +35,19 @@ sw_args <- function(dir, files.in, echo, quiet) {
+#' Turn on/off `SOILWAT2` notes and warnings
+#'
+#' @param verbose A logical value.
+#' Verbose mode prints any \pkg{SOILWAT2} messages.
+#'
+#' @return The previous logical value.
+#'
+#' @export
+sw_verbosity <- function(verbose = TRUE) {
+ invisible(!.Call(C_sw_quiet, !as.logical(verbose)))
+}
+
+
#' Execute a \pkg{rSOILWAT2} simulation run
#'
#' Run the simulation and get the output data. Executes the \pkg{SOILWAT2}
@@ -60,7 +73,8 @@ sw_args <- function(dir, files.in, echo, quiet) {
#' built-in Markov weather generator (see examples section). If you use the
#' weather generator, then you have to provide appropriate values for the input
#' (files) \var{mkv_covar.in} and \var{mkv_prob.in} for your simulation run -
-#' currently, \pkg{rSOILWAT2} does not contain code to estimate these values.
+#' see \code{\link{dbW_estimate_WGen_coefs}} or
+#' \code{\link{dbW_generateWeather}}.
#'
#' @param inputData an object of the \var{S4} class
#' \code{\linkS4class{swInputData}} which is generated from
@@ -69,11 +83,13 @@ sw_args <- function(dir, files.in, echo, quiet) {
#' \code{\link{dbW_getWeatherData}} or \code{\link{getWeatherData_folders}}.
#' @param dir a character vector that represents the path to the input data. Use
#' with \code{files.in}
-#' @param files.in a character vector that represents the partial path of the
-#' \var{files.in} file
+#' @param files.in A character string. The file name (and path relative to
+#' \code{dir}) of the \var{files} input file that contains information
+#' about the remaining input files.
#' @param echo logical. This option will echo the inputs to the \var{logfile}.
#' Helpful for debugging.
-#' @param quiet logical. Quiet mode doesn't print messages to the \var{logfile}.
+#' @param quiet logical. Quiet mode hides any \pkg{SOILWAT2} messages,
+#' see \code{\link{sw_verbosity}}.
#'
#' @return An object of class \code{\linkS4class{swOutput}}.
#'
@@ -143,8 +159,11 @@ sw_args <- function(dir, files.in, echo, quiet) {
#' ## to set up a SQLite database for the weather data)
#' sw_weath3 <- getWeatherData_folders(
#' LookupWeatherFolder = file.path(path_demo, "Input"),
-#' weatherDirName = "data_weather", filebasename = "weath",
-#' startYear = 1979, endYear = 2010)
+#' weatherDirName = "data_weather",
+#' filebasename = "weath",
+#' startYear = 1979,
+#' endYear = 2010
+#' )
#'
#' ## List of the slots of the input objects of class 'swWeatherData'
#' utils::str(sw_weath3, max.level = 1)
@@ -200,21 +219,45 @@ sw_args <- function(dir, files.in, echo, quiet) {
#' print(round(as.numeric(object.size(sw_out6) / object.size(sw_out5)), 2))
#'
#'
+#' ## ------ Simulation with different SWRC ------------
+#' if (requireNamespace("curl") && curl::has_internet()) {
+#' sw_in7 <- sw_in3
+#' swSite_SWRCflags(sw_in7) <- c("vanGenuchten1980", "Rosetta3")
+#'
+#' sw_out7 <- sw_exec(inputData = sw_in7, weatherList = sw_weath3)
+#' }
+#'
#' ## See help(package = "rSOILWAT2") for a full list of functions
#'
#' @export
-sw_exec <- function(inputData = NULL, weatherList = NULL, dir = "",
- files.in = "files.in", echo = FALSE, quiet = FALSE) {
+sw_exec <- function(
+ inputData = NULL,
+ weatherList = NULL,
+ dir = ".",
+ files.in = "files.in",
+ echo = FALSE,
+ quiet = FALSE
+) {
dir_prev <- getwd()
on.exit(setwd(dir_prev), add = TRUE)
+ quiet <- as.logical(quiet)
+
input <- sw_args(dir, files.in, echo, quiet)
if (is.null(inputData)) {
- inputData <- sw_inputDataFromFiles(dir = dir, files.in = files.in)
+ inputData <- sw_inputDataFromFiles(
+ dir = dir,
+ files.in = files.in,
+ quiet = quiet
+ )
}
+
+ # Upgrade essential slots if input object is from an older version
+ inputData <- sw_upgrade(inputData, verbose = !quiet)
+
if (!check_version(inputData, level = "minor")) {
warning(
"Object `inputData is outdated; ",
@@ -222,7 +265,52 @@ sw_exec <- function(inputData = NULL, weatherList = NULL, dir = "",
)
}
- res <- .Call(C_start, input, inputData, weatherList, as.logical(quiet))
+
+ # Upgrade weather data if object is from an outdated version
+ if (!is.null(weatherList)) {
+ weatherList <- upgrade_weatherHistory(weatherList, verbose = !quiet)
+
+ if (!dbW_check_weatherData(weatherList)) {
+ warning(
+ "Object `weatherList is outdated; ",
+ "SOILWAT2 may fail or produce unexpected outcomes."
+ )
+ }
+ }
+
+
+ #--- Estimate SWRC parameters
+ # if not yet estimated
+ # if requested PTF only implemented in R
+ if (!swSite_hasSWRCp(inputData)) {
+ ptf_name <- std_ptf(swSite_SWRCflags(inputData)["ptf_name"])
+ if (ptf_name %in% ptfs_implemented_by_rSW2()) {
+ soils <- swSoils_Layers(inputData)
+
+ swrcp <- rSW2_SWRC_PTF_estimate_parameters(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"],
+ bdensity = soils[, "bulkDensity_g/cm^3"],
+ ptf_name = ptf_name,
+ fail = FALSE
+ )
+
+ if (!is.null(swrcp)) {
+ swSite_hasSWRCp(inputData) <- TRUE
+ swSoils_SWRCp(inputData) <- swrcp
+ } else {
+ swSoils_SWRCp(inputData) <- array(
+ data = NA_real_,
+ dim = dim(swSoils_SWRCp(inputData))
+ )
+ }
+ }
+ }
+
+
+ # Run SOILWAT2
+ res <- .Call(C_start, input, inputData, weatherList, quiet)
slot(res, "version") <- rSW2_version()
slot(res, "timestamp") <- rSW2_timestamp()
@@ -232,7 +320,7 @@ sw_exec <- function(inputData = NULL, weatherList = NULL, dir = "",
st_name <- rSW2_glovars[["kSOILWAT2"]][["OutKeys"]][["SW_SOILTEMP"]]
tempd <- slot(res, st_name)
- for (k in rSW2_glovars[["sw_TimeSteps"]]) {
+ for (k in rSW2_glovars[["kSOILWAT2"]][["OutPeriods"]]) {
temp <- slot(tempd, k)
np <- dim(temp)
if (np[1] > 0) {
@@ -252,10 +340,7 @@ sw_exec <- function(inputData = NULL, weatherList = NULL, dir = "",
#' Read simulation input data from files on disk
#'
-#' @param dir A character string. The path to the simulation project directory.
-#' @param files.in A character string. The file name (and path relative to
-#' \code{dir}) of the \var{files} input file that contains information
-#' about the remaining input files.
+#' @inheritParams sw_exec
#'
#' @return An object of class \code{\linkS4class{swInputData}}.
#'
@@ -284,14 +369,20 @@ sw_exec <- function(inputData = NULL, weatherList = NULL, dir = "",
#'
#'
#' @export
-sw_inputDataFromFiles <- function(dir = "", files.in = "files.in") {
+sw_inputDataFromFiles <- function(
+ dir = "",
+ files.in = "files.in",
+ quiet = FALSE
+) {
dir_prev <- getwd()
on.exit(setwd(dir_prev), add = TRUE)
- input <- sw_args(dir, files.in, echo = FALSE, quiet = FALSE)
+ quiet <- as.logical(quiet)
- res <- .Call(C_onGetInputDataFromFiles, input)
+ input <- sw_args(dir, files.in, echo = FALSE, quiet = quiet)
+
+ res <- .Call(C_onGetInputDataFromFiles, input, quiet)
slot(res, "version") <- rSW2_version()
slot(res, "timestamp") <- rSW2_timestamp()
@@ -301,7 +392,8 @@ sw_inputDataFromFiles <- function(dir = "", files.in = "files.in") {
#' Return output data
#'
-#' @param inputData An object of class \code{\linkS4class{swInputData}}.
+#' @inheritParams sw_exec
+#'
#' @return An object of class \code{\linkS4class{swOutput}}.
#' @export
sw_outputData <- function(inputData) {
@@ -347,11 +439,11 @@ sw_inputData <- function() {
dir_prev <- getwd()
on.exit(setwd(dir_prev), add = TRUE)
- temp <- new("swInputData") # data are from calls to `initialize`-methods
+ tmp <- swInputData() # default values (minus some deleted slots)
utils::data(package = "rSOILWAT2", "weatherData", envir = environment())
- slot(temp, "weatherHistory") <- get("weatherData", envir = environment())
+ slot(tmp, "weatherHistory") <- get("weatherData", envir = environment())
- temp
+ tmp
}
diff --git a/R/data.R b/R/data.R
index 71886dff..18baf221 100644
--- a/R/data.R
+++ b/R/data.R
@@ -31,7 +31,8 @@
#' site-specific simulation run is discouraged (even though there are many
#' such examples throughout the documentation of this package).
#' The recommended approach is to create a clean new object with
-#' \code{new("swInputData")} and then set all site-specific inputs and
+#' the helper constructor \code{swInputData()} (or based on the prototype
+#' \code{new("swInputData")}) and then set all site-specific inputs and
#' parameters. See \var{\dQuote{rSOILWAT2_demo}} vignette.
#'
#' @examples
@@ -75,7 +76,7 @@
#' represent amount of roots per centimeter soil depth.
#' }
#' \item{data}{
-#' A code{data.frame} with the rooting profile values.
+#' A \code{data.frame} with the rooting profile values.
#' }
#' }
#'
diff --git a/R/rSOILWAT2-defunct.R b/R/rSOILWAT2-defunct.R
index 971e1c4a..baf4934d 100644
--- a/R/rSOILWAT2-defunct.R
+++ b/R/rSOILWAT2-defunct.R
@@ -3,6 +3,8 @@
#' Executing a defunct function will fail and tell you which function
#' replaces them.
#'
+#' @param ... Function arguments. Unused since functions are defunct.
+#'
#' @name rSOILWAT2-defunct
NULL
diff --git a/R/rSOILWAT2-package.R b/R/rSOILWAT2-package.R
index ee0d8c2a..0cad3435 100644
--- a/R/rSOILWAT2-package.R
+++ b/R/rSOILWAT2-package.R
@@ -49,7 +49,7 @@ rSW2_glovars <- new.env()
##------ Import from other packages
## Package uses S3/S4 classes - they are defined in package:methods
-#' @importFrom methods slot slot<- as as<- initialize new slotNames
+#' @importFrom methods slot slot<- as as<- new slotNames
#' inheritedSlotNames getSlots validObject callNextMethod
#' @importFrom stats aggregate coef complete.cases cor cov fitted median
#' na.exclude na.omit predict quantile sd weighted.mean
diff --git a/R/rSOILWAT2_deprecated.R b/R/rSOILWAT2_deprecated.R
index bfc99147..12956ab1 100644
--- a/R/rSOILWAT2_deprecated.R
+++ b/R/rSOILWAT2_deprecated.R
@@ -88,7 +88,15 @@ dbW_addWeatherData_old <- function(Site_id=NULL, lat=NULL, long=NULL, weatherFol
.Deprecated("dbW_addWeatherData")
stopifnot(dbW_IsValid())
- if ((is.null(weatherFolderPath) | ifelse(!is.null(weatherFolderPath), (weatherFolderPath == "" | !file.exists(weatherFolderPath)), FALSE)) & (is.null(weatherData) | !is.list(weatherData) | !inherits(weatherData[[1]], "swWeatherData"))) stop("addWeatherDataToDataBase does not have folder path or weatherData to insert")
+ if (
+ (
+ is.null(weatherFolderPath) |
+ ifelse(!is.null(weatherFolderPath), (weatherFolderPath == "" | !file.exists(weatherFolderPath)), FALSE)
+ ) &
+ (is.null(weatherData) | !is.list(weatherData) | !inherits(weatherData[[1]], "swWeatherData"))
+ ) {
+ stop("addWeatherDataToDataBase does not have folder path or weatherData to insert")
+ }
if( (is.null(Site_id) & is.null(lat) & is.null(long) & is.null(weatherFolderPath) & (is.null(label))) | ((!is.null(Site_id) & !is.numeric(Site_id)) & (!is.null(lat) & !is.numeric(lat)) & (!is.null(long) & !is.numeric(long))) ) stop("addWeatherDataToDataBase not enough info to create Site in Sites table.")
Site_id <- dbW_addSite(
@@ -175,6 +183,12 @@ dbW_weatherData_to_blob_old <- function(weatherData, type = "gzip") {
+#' Add a new site description to a weather database
+#'
+#' @param Site_id An integer value. The identification number of the site.
+#' @param lat A numeric value. The latitude of the site.
+#' @param long A numeric value. The longitude of the site.
+#' @param Label A character string. The name of the site.
#' @export
dbW_addSite <- function(Site_id = NULL, lat = NULL, long = NULL, Label = NULL) {
.Deprecated("dbW_addSites")
@@ -224,3 +238,1020 @@ dbW_addSite <- function(Site_id = NULL, lat = NULL, long = NULL, Label = NULL) {
Site_id
}
+
+#' Calculate variables required to estimate percent C4 species in North America
+#'
+#' @param dailyTempMin A numeric vector. Time series of daily minimum air
+#' temperature `[C]`.
+#' @param dailyTempMean A numeric vector. Time series of daily mean air
+#' temperature `[C]`.
+#' @param simTime2 A list with two named elements. The elements are numeric
+#' vectors \var{month_ForEachUsedDay_NSadj} and
+#' \var{year_ForEachUsedDay_NSadj}; they are calculated internally
+#' if \code{NULL}; alternatively, they can be generated by a call to the
+#' function \code{\link[rSW2data]{simTiming_ForEachUsedTimeUnit}}.
+#'
+#' @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.
+#'
+#' @export
+#' @md
+sw_dailyC4_TempVar <- function(dailyTempMin, dailyTempMean, simTime2) {
+ .Deprecated("calc_SiteClimate")
+ 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, sd))
+ temp <- c("Month7th_NSadj_MinTemp_C",
+ "LengthFreezeFreeGrowingPeriod_NSadj_Days",
+ "DegreeDaysAbove65F_NSadj_DaysC")
+ names(res) <- c(temp, paste0(temp, ".sd"))
+
+ res
+}
+
+#' Calculate climate variables required to estimate percent cheatgrass cover
+#' in North America
+#'
+#' @section Note: This function does not correct for northern/southern
+#' hemisphere.
+#'
+#' @param monthlyPPT_cm A numeric matrix of monthly precipitation values in
+#' centimeter. There are 12 rows, one for each month of the year;
+#' and there is one column for each year.
+#' @param monthlyTempMean_C A numeric matrix of monthly mean temperature values
+#' in degree Celsius. There are 12 rows, one for each month of the year;
+#' and there is one column for each year.
+#' @param monthlyTempMin_C A numeric matrix of monthly minimum temperature
+#' value sin degree Celsius. There are 12 rows, one for each month of the
+#' year; and there is one column for each year.
+#'
+#' @return A named numeric vector of length 6 with mean and standard deviation
+#' for \var{Month7th_PPT_mm}, \var{MeanTemp_ofDriestQuarter_C}, and
+#' \var{MinTemp_of2ndMonth_C}.
+#'
+#' @references Brummer, T. J., K. T. Taylor, J. Rotella, B. D. Maxwell,
+#' L. J. Rew, and M. Lavin. 2016. Drivers of Bromus tectorum Abundance in
+#' the Western North American Sagebrush Steppe. Ecosystems 19:986-1000.
+#'
+#' @export
+sw_Cheatgrass_ClimVar <- function(monthlyPPT_cm,
+ monthlyTempMean_C = NULL, monthlyTempMin_C = NULL) {
+ .Deprecated("calc_SiteClimate")
+ # Mean precipitation sum of seventh month of the season (i.e.,
+ # July in northern hemisphere)
+ Month7th_PPT_mm <- 10 * monthlyPPT_cm[7, ]
+ nyrs <- seq_along(Month7th_PPT_mm)
+
+ # Mean temperature of driest quarter (Bioclim variable 9)
+ # see \code{link[dismo]{biovars}}
+ if (!is.null(monthlyTempMean_C)) {
+ wet <- t(apply(monthlyPPT_cm, 2, rSW2utils::moving_function,
+ k = 3, win_fun = sum, na.rm = TRUE, circular = TRUE
+ ))
+ tmp <- t(apply(monthlyTempMean_C, 2, rSW2utils::moving_function,
+ k = 3, win_fun = mean, na.rm = TRUE, circular = TRUE
+ ))
+ dryqrt <- cbind(
+ seq_len(ncol(monthlyPPT_cm)),
+ as.integer(apply(wet, 1, which.min))
+ )
+ MeanTemp_ofDriestQuarter_C <- tmp[dryqrt]
+
+ } else {
+ MeanTemp_ofDriestQuarter_C <- rep(NA, length(Month7th_PPT_mm))
+ }
+
+ # Minimum February temperature
+ if (!is.null(monthlyTempMin_C)) {
+ MinTemp_of2ndMonth_C <- monthlyTempMin_C[2, , ]
+ } else {
+ MinTemp_of2ndMonth_C <- rep(NA, length(Month7th_PPT_mm))
+ }
+
+
+ # Aggregate
+ temp <- cbind(
+ Month7th_PPT_mm[nyrs],
+ MeanTemp_ofDriestQuarter_C[nyrs],
+ MinTemp_of2ndMonth_C[nyrs]
+ )
+
+ res <- c(apply(temp, 2, mean), apply(temp, 2, sd))
+ temp <- c("Month7th_PPT_mm", "MeanTemp_ofDriestQuarter_C",
+ "MinTemp_of2ndMonth_C")
+ names(res) <- c(temp, paste0(temp, "_SD"))
+
+ res
+}
+
+#' Old way of calculating climate variables (previous to `v6.0.0`)
+#'
+#' @examples
+#' # Compare new and old function
+#' wdata <- rSOILWAT2::get_WeatherHistory(rSOILWAT2::sw_exampleData)
+#'
+#' fun_clim <- function(fun) {
+#' lapply(
+#' c(-90, 90),
+#' function(latitude) {
+#' fun(
+#' weatherList = wdata,
+#' do_C4vars = TRUE,
+#' do_Cheatgrass_ClimVars = TRUE,
+#' latitude = latitude
+#' )
+#' }
+#' )
+#' }
+#'
+#' clim_old <- fun_clim(rSOILWAT2:::calc_SiteClimate_old)
+#' clim_new <- fun_clim(rSOILWAT2::calc_SiteClimate)
+#'
+#' # Compare values assuming northern hemisphere:
+#' all.equal(clim_old[[1]], clim_new[[1]])
+#' # MAT_C: Mean relative difference: 2.740629e-05
+#'
+#' # Compare values assuming southern hemisphere:
+#' all.equal(clim_old[[2]], clim_new[[2]])
+#' # MAT_C: Mean relative difference: 2.740629e-05
+#' # dailyC4vars: Mean relative difference: 0.05932631
+#' # Cheatgrass_ClimVars: Mean relative difference: 0.707922
+#'
+#' # Difference in `MAT`:
+#' cat(
+#' "MAT_C(old) = ", clim_old[[2]][["MAT_C"]],
+#' "vs. MAT_C(new) = ", clim_new[[2]][["MAT_C"]],
+#' fill = TRUE
+#' )
+#' # MAT_C(old) = 4.153896 vs. MAT_C(new) = 4.154009
+#'
+#' # Reason for differences in mean annual temperature `MAT`:
+#' # The new version calculates the mean across years of
+#' # means across days within year of mean daily temperature;
+#' # previously, it was incorrectly calculated as the mean across all days.
+#'
+#'
+#' # Differences in `dailyC4vars`:
+#' print(
+#' cbind(
+#' old = clim_old[[2]][["dailyC4vars"]],
+#' new = clim_new[[2]][["dailyC4vars"]]
+#' )
+#' )
+#' # old new
+#' # Month7th_NSadj_MinTemp_C -27.243871 -27.199333
+#' # LengthFreezeFreeGrowingPeriod_NSadj_Days 68.290323 72.600000
+#' # DegreeDaysAbove65F_NSadj_DaysC 20.684935 21.357533
+#' # Month7th_NSadj_MinTemp_C.sd 5.241726 5.325365
+#' # LengthFreezeFreeGrowingPeriod_NSadj_Days.sd 13.446669 9.586629
+#' # DegreeDaysAbove65F_NSadj_DaysC.sd 19.755513 19.550419
+#'
+#' Explanation for different values:
+#'
+#' # Reason for differences in `dailyC4vars`:
+#' # The new version adjusts years at locations in the southern hemisphere
+#' # to start on July 1 of the previous calendar year;
+#' # previously, the adjusted start date varied from July 1 to July 4.
+#'
+#'
+#' # Differences in `Cheatgrass_ClimVars`:
+#' print(
+#' cbind(
+#' old = clim_old[[2]][["Cheatgrass_ClimVars"]],
+#' new = clim_new[[2]][["Cheatgrass_ClimVars"]]
+#' )
+#' )
+#' # old new
+#' # Month7th_PPT_mm 35.729032 65.916667
+#' # MeanTemp_ofDriestQuarter_C 11.524859 11.401228
+#' # MinTemp_of2ndMonth_C -13.904600 6.545578
+#' # Month7th_PPT_mm_SD 21.598367 35.285409
+#' # MeanTemp_ofDriestQuarter_C_SD 7.171922 7.260852
+#' # MinTemp_of2ndMonth_C_SD 2.618434 1.639640
+#'
+#' # Reason for differences in `Cheatgrass_ClimVars`:
+#' # The new version now adjusts these variables for location by hemisphere;
+#' # previously, they were calculated as if in the northern hemisphere
+#' # regardless of actual location.
+#'
+#'
+#' # Benchmarks: new version is about 20x faster
+#' bm <- microbenchmark::microbenchmark(
+#' old = fun_clim(rSOILWAT2:::calc_SiteClimate_old),
+#' new = fun_clim(rSOILWAT2::calc_SiteClimate)
+#' )
+#'
+#' # Unit: milliseconds
+#' # expr min lq mean median uq max neval
+#' # old 136.41207 149.689687 157.494004 154.114424 157.490437 277.3953 100
+#' # new 3.07084 3.422651 6.992061 3.694008 4.082199 119.7300 100
+#'
+#'
+#' @noRd
+calc_SiteClimate_old <- function(weatherList, year.start = NA, year.end = NA,
+ do_C4vars = FALSE, do_Cheatgrass_ClimVars = FALSE, simTime2 = NULL,
+ latitude = 90) {
+ .Deprecated("calc_SiteClimate")
+ x <- dbW_weatherData_to_dataframe(weatherList)
+
+ # Trim to requested years
+ if (!is.na(year.start)) {
+ x <- x[x[, "Year"] >= year.start, ]
+ } else {
+ year.start <- x[1, "Year"]
+ }
+
+ if (!is.na(year.end)) {
+ x <- x[x[, "Year"] <= year.end, ]
+ } else {
+ year.end <- x[nrow(x), "Year"]
+ }
+
+ years <- unique(x[, "Year"])
+
+ if (length(years) == 0) {
+ stop("'calc_SiteClimate': no weather data available for ",
+ "requested range of years")
+ }
+
+ # Mean daily temperature
+ Tmean_C <- rowMeans(x[, c("Tmax_C", "Tmin_C")])
+
+ # Get time sequence information
+ is_simTime2_good <- !is.null(simTime2) &&
+ identical(years, simTime2[["useyrs_NSadj"]]) &&
+ !is.null(simTime2[["month_ForEachUsedDay"]])
+
+ is_simTime2_good_for_C4vars <- if (do_C4vars) {
+ if (is_simTime2_good) {
+ !is.null(simTime2[["month_ForEachUsedDay_NSadj"]]) &&
+ !is.null(simTime2[["year_ForEachUsedDay_NSadj"]])
+ } else {
+ FALSE
+ }
+ } else {
+ TRUE
+ }
+
+ if (is_simTime2_good && is_simTime2_good_for_C4vars) {
+ st2 <- simTime2
+ } else {
+ st2 <- rSW2data::simTiming_ForEachUsedTimeUnit(
+ useyrs = years,
+ sim_tscales = "daily",
+ latitude = latitude,
+ account_NorthSouth = do_C4vars
+ )
+ }
+
+ # Calculate monthly values
+ index <- st2[["month_ForEachUsedDay"]] + 100 * x[, "Year"]
+
+ mon_Temp <- vapply(
+ list(Tmean_C, x[, "Tmin_C"], x[, "Tmax_C"]),
+ function(data) matrix(tapply(data, index, mean, na.rm = TRUE), nrow = 12),
+ FUN.VALUE = matrix(NA_real_, nrow = 12, ncol = length(years))
+ )
+
+ mon_PPT <- matrix(tapply(x[, "PPT_cm"], index, sum, na.rm = TRUE), nrow = 12)
+
+ list(
+ # Calculate mean monthly values
+ meanMonthlyTempC = apply(mon_Temp[, , 1, drop = FALSE], 1, mean,
+ na.rm = TRUE),
+ minMonthlyTempC = apply(mon_Temp[, , 2, drop = FALSE], 1, mean,
+ na.rm = TRUE),
+ maxMonthlyTempC = apply(mon_Temp[, , 3, drop = FALSE], 1, mean,
+ na.rm = TRUE),
+ meanMonthlyPPTcm = apply(mon_PPT, 1, mean, na.rm = TRUE),
+
+ # Calculate mean annual values
+ MAP_cm = sum(mon_PPT, na.rm = TRUE) / length(years),
+ MAT_C = mean(Tmean_C, na.rm = TRUE),
+
+ # If C4-variables are requested
+ dailyTempMin = if (do_C4vars) x[, "Tmin_C"] else NA,
+ dailyTempMean = if (do_C4vars) Tmean_C else NA,
+ dailyC4vars = if (do_C4vars) {
+ sw_dailyC4_TempVar(
+ dailyTempMin = x[, "Tmin_C"],
+ dailyTempMean = Tmean_C,
+ simTime2 = st2
+ )
+ } else {
+ NA
+ },
+
+ # If cheatgrass-variables are requested
+ Cheatgrass_ClimVars = if (do_Cheatgrass_ClimVars) {
+ sw_Cheatgrass_ClimVar(
+ monthlyPPT_cm = mon_PPT,
+ monthlyTempMean_C = mon_Temp[, , 1, drop = FALSE],
+ monthlyTempMin_C = mon_Temp[, , 2, drop = FALSE]
+ )
+ } else {
+ NA
+ }
+ )
+}
+
+#' Old function to estimate natural vegetation cover (previous to `v6.0.0`)
+#'
+#' @examples
+#' # Compare new and old function
+#' wdata <- rSOILWAT2::get_WeatherHistory(rSOILWAT2::sw_exampleData)
+#' clim1 <- calc_SiteClimate(weatherList = wdata, do_C4vars = TRUE)
+#'
+#' fun_pnvcov <- function(fun, clim, fix_issues = FALSE) {
+#' lapply(
+#' c(90, -90),
+#' function(latitude) {
+#' tmp_args <- list(
+#' MAP_mm = 10 * clim[["MAP_cm"]],
+#' MAT_C = clim[["MAT_C"]],
+#' mean_monthly_ppt_mm = 10 * clim[["meanMonthlyPPTcm"]],
+#' mean_monthly_Temp_C = clim[["meanMonthlyTempC"]],
+#' dailyC4vars = clim[["dailyC4vars"]],
+#' isNorth = latitude >= 0
+#' )
+#' if (fix_issues) {
+#' tmp_args[["fix_issue218"]] <- TRUE
+#' tmp_args[["fix_issue219"]] <- TRUE
+#' }
+#' do.call(fun, tmp_args)
+#' }
+#' )
+#' }
+#'
+#' cov_old <- fun_pnvcov(rSOILWAT2:::estimate_PotNatVeg_composition_old, clim1)
+#' cov_old2 <- fun_pnvcov(
+#' rSOILWAT2:::estimate_PotNatVeg_composition_old,
+#' clim1,
+#' fix_issues = TRUE
+#' )
+#' cov_new <- fun_pnvcov(rSOILWAT2::estimate_PotNatVeg_composition, clim1)
+#'
+#' # Compare values as if northern hemisphere:
+#' print(
+#' cbind(
+#' old = cov_old[[1]][["Rel_Abundance_L0"]],
+#' oldfixed = cov_old2[[1]][["Rel_Abundance_L0"]],
+#' new = cov_new[[1]][["Rel_Abundance_L0"]]
+#' )
+#' )
+#' # old oldfixed new
+#' # Succulents 0.0000000 0.0000000 0.0000000
+#' # Forbs 0.2608391 0.2608391 0.2608391
+#' # Grasses_C3 0.4307061 0.4307061 0.4307061
+#' # Grasses_C4 0.0000000 0.0000000 0.0000000
+#' # Grasses_Annuals 0.0000000 0.0000000 0.0000000
+#' # Shrubs 0.3084547 0.3084547 0.3084547
+#' # Trees 0.0000000 0.0000000 0.0000000
+#' # BareGround 0.0000000 0.0000000 0.0000000
+#'
+#' # Compare values as if southern hemisphere:
+#' print(
+#' cbind(
+#' old = cov_old[[2]][["Rel_Abundance_L0"]],
+#' oldfixed = cov_old2[[2]][["Rel_Abundance_L0"]],
+#' new = cov_new[[2]][["Rel_Abundance_L0"]]
+#' )
+#' )
+#' # old oldfixed new
+#' # Succulents 0.00000000 0.0000000 0.0000000
+#' # Forbs 0.22804606 0.2707322 0.2707322
+#' # Grasses_C3 0.52575060 0.6241618 0.6241618
+#' # Grasses_C4 0.15766932 0.0000000 0.0000000
+#' # Grasses_Annuals 0.00000000 0.0000000 0.0000000
+#' # Shrubs 0.08853402 0.1051060 0.1051060
+#' # Trees 0.00000000 0.0000000 0.0000000
+#' # BareGround 0.00000000 0.0000000 0.0000000
+#'
+#' # Explanation for different values:
+#' # `old` and `oldfixes` differ because of issue #218 (correction for
+#' # `C4` grass cover was not carried out as documented) and issue #219
+#' # (output incorrectly contained negative cover if fixed `SumGrasses_Fraction`
+#' # caused that other fixed cover summed > 1);
+#' # `oldfixed` and `new` produce identical output.
+#'
+#'
+#' # Benchmarks: new version is about 15x faster
+#' bm <- microbenchmark::microbenchmark(
+#' old = fun_pnvcov(rSOILWAT2:::estimate_PotNatVeg_composition_old, clim1),
+#' new = fun_pnvcov(rSOILWAT2::estimate_PotNatVeg_composition, clim1)
+#' )
+#'
+#' # Unit: microseconds
+#' # expr min lq mean median uq max neval
+#' # old 450.820 467.7365 499.84000 503.8165 515.4235 711.459 100
+#' # new 25.467 28.3930 33.95104 31.4155 39.8005 54.414 100
+#'
+#'
+#' # issue 218: correction to C4 grass cover was not carried out as documented
+#' for (fix_issue218 in c(FALSE, TRUE)) {
+#' tmp <- rSOILWAT2:::estimate_PotNatVeg_composition_old(
+#' MAP_mm = 10 * clim1[["MAP_cm"]],
+#' MAT_C = 10,
+#' mean_monthly_ppt_mm = 10 * clim1[["meanMonthlyPPTcm"]],
+#' mean_monthly_Temp_C = 5 + clim1[["meanMonthlyTempC"]],
+#' dailyC4vars = c(
+#' Month7th_NSadj_MinTemp_C = 3,
+#' LengthFreezeFreeGrowingPeriod_NSadj_Days = 150,
+#' DegreeDaysAbove65F_NSadj_DaysC = 110
+#' ),
+#' fix_issue218 = fix_issue218
+#' )
+#' print(tmp[["Grasses"]])
+#' }
+#' # Grasses_C3 Grasses_C4 Grasses_Annuals
+#' # 0.4522766 0.5477234 0.0000000
+#' # Grasses_C3 Grasses_C4 Grasses_Annuals
+#' # 1 0 0
+#'
+#'
+#' # issue 219: output incorrectly contained negative cover
+#' # if fixed `SumGrasses_Fraction` caused that other fixed cover summed > 1
+#' # expect error with issue 219 fixed
+#' for (fix_issue219 in c(FALSE, TRUE)) {
+#' tmp <- try(
+#' rSOILWAT2:::estimate_PotNatVeg_composition_old(
+#' MAP_mm = 10 * clim1[["MAP_cm"]],
+#' MAT_C = clim1[["MAT_C"]],
+#' mean_monthly_ppt_mm = 10 * clim1[["meanMonthlyPPTcm"]],
+#' mean_monthly_Temp_C = clim1[["meanMonthlyTempC"]],
+#' dailyC4vars = clim1[["dailyC4vars"]],
+#' fix_shrubs = TRUE,
+#' Shrubs_Fraction = 0.5,
+#' fix_sumgrasses = TRUE,
+#' SumGrasses_Fraction = 0.7,
+#' fix_issue219 = fix_issue219
+#' ),
+#' silent = TRUE
+#' )
+#' if (inherits(tmp, "try-error")) {
+#' print(as.character(tmp))
+#' } else {
+#' print(tmp[["Rel_Abundance_L1"]])
+#' }
+#' }
+#' # SW_TREES SW_SHRUB SW_FORBS SW_GRASS SW_BAREGROUND
+#' # 0.0 0.5 -0.2 0.7 0.0
+#' # [1] "Error in rSOILWAT2:::estimate_PotNatVeg_composition_old ..."
+#'
+#' @noRd
+estimate_PotNatVeg_composition_old <- function(MAP_mm, MAT_C,
+ mean_monthly_ppt_mm, mean_monthly_Temp_C, dailyC4vars = NULL,
+ isNorth = TRUE, shrub_limit = 0.2,
+ fix_succulents = FALSE, Succulents_Fraction = NA,
+ fix_sumgrasses = FALSE, SumGrasses_Fraction = NA,
+ fix_annuals = TRUE, Annuals_Fraction = 0,
+ fix_C4grasses = FALSE, C4_Fraction = NA,
+ fix_C3grasses = FALSE, C3_Fraction = NA,
+ fix_shrubs = FALSE, Shrubs_Fraction = NA,
+ fix_forbs = FALSE, Forbs_Fraction = NA,
+ fix_trees = TRUE, Trees_Fraction = 0,
+ fix_BareGround = TRUE, BareGround_Fraction = 0,
+ fill_empty_with_BareGround = TRUE,
+ warn_extrapolation = TRUE,
+ fix_issue218 = FALSE,
+ fix_issue219 = FALSE
+) {
+ .Deprecated("estimate_PotNatVeg_composition")
+ veg_types <- c(
+ "Succulents", "Forbs",
+ "Grasses_C3", "Grasses_C4", "Grasses_Annuals",
+ "Shrubs", "Trees",
+ "BareGround"
+ )
+ Nveg <- length(veg_types)
+
+ isuc <- 1 # succulents
+ ifor <- 2 # forbs
+ igc3 <- 3 # grasses-C3
+ igc4 <- 4 # grasses-C4
+ igan <- 5 # grasses-annuals
+ ishr <- 6 # shrubs
+ itre <- 7 # trees
+ ibar <- 8 # bare-ground
+
+ veg_cover <- rep(0, Nveg)
+
+ # groups without climate-equations, i.e., always set to a specific value
+ iset <- c(igan, itre, ibar)
+
+ # groups with climate-equations to estimate relative abundance
+ iestim <- c(igc4, igc3, ishr, ifor, isuc)
+ igrasses <- c(igc3, igc4, igan)
+
+
+ #--- Get the user specified fractions: input cover fraction values:
+ input_cover <- rep(NA, Nveg)
+
+ # Groups that are either fixed or 0, i.e., cannot be NA = not estimated
+ input_cover[igan] <- if (fix_annuals) {
+ rSW2utils::finite01(Annuals_Fraction)
+ } else {
+ 0
+ }
+ input_cover[itre] <- if (fix_trees) {
+ rSW2utils::finite01(Trees_Fraction)
+ } else {
+ 0
+ }
+ input_cover[ibar] <- if (fix_BareGround) {
+ rSW2utils::finite01(BareGround_Fraction)
+ } else {
+ 0
+ }
+
+ # Groups that are either fixed or estimated based on climate-relationships
+ input_cover[igc4] <- if (fix_C4grasses) C4_Fraction else NA
+ input_cover[igc3] <- if (fix_C3grasses) C3_Fraction else NA
+ input_cover[ishr] <- if (fix_shrubs) Shrubs_Fraction else NA
+ input_cover[ifor] <- if (fix_forbs) Forbs_Fraction else NA
+ input_cover[isuc] <- if (fix_succulents) Succulents_Fraction else NA
+
+ # treat negative input values as if NA
+ input_cover <- rSW2utils::cut0Inf(input_cover, val = NA)
+
+
+ #--- Check individual components if the sum of grasses is fixed
+ fix_sumgrasses <- fix_sumgrasses && isTRUE(!is.na(SumGrasses_Fraction))
+
+ if (fix_sumgrasses) {
+ SumGrasses_Fraction <- rSW2utils::cut0Inf(SumGrasses_Fraction, val = 0)
+
+ input_sum_grasses <- rSW2utils::replace_NAs_with_val(
+ x = sum(input_cover[igrasses], na.rm = TRUE),
+ val_replace = 0
+ )
+
+ add_sum_grasses <- SumGrasses_Fraction - input_sum_grasses
+
+ if (add_sum_grasses < 0) {
+ stop(
+ "'estimate_PotNatVeg_composition': ",
+ "User defined grass values including C3, C4, and annuals ",
+ "sum to more than user defined total grass cover."
+ )
+
+ }
+
+ ids_to_estim_grasses <- is.na(input_cover[igrasses])
+
+ if (add_sum_grasses > 0) {
+ if (sum(ids_to_estim_grasses) == 1) {
+ # One grass component to estimate: difference from rest
+ input_cover[igrasses[ids_to_estim_grasses]] <-
+ SumGrasses_Fraction - input_sum_grasses
+
+ add_sum_grasses <- 0
+ }
+
+ } else {
+ # No grass component to add: set all to zero
+ input_cover[igrasses[ids_to_estim_grasses]] <- 0
+ }
+ }
+
+
+ #--- Decide if all fractions are sufficiently defined or if they need to be
+ # estimated based on climate reltionships
+ input_sum <- sum(input_cover, na.rm = TRUE)
+
+ if (isTRUE(fix_issue219)) {
+ if (fix_sumgrasses && isTRUE(add_sum_grasses > 0)) {
+ input_sum <- input_sum + add_sum_grasses
+ }
+ }
+
+ ifixed <- unique(c(iset, which(!is.na(input_cover))))
+
+ ids_to_estim <- which(is.na(input_cover))
+ n_to_estim <- length(ids_to_estim)
+
+ if (input_sum > 1) {
+ stop(
+ "'estimate_PotNatVeg_composition': ",
+ "User defined relative abundance values sum to more than ",
+ "1 = full land cover."
+ )
+ }
+
+
+ #--- Incomplete surface cover
+ veg_cover <- input_cover
+
+ if (n_to_estim <= 1) {
+ #--- Less than one component to estimate: no need for equations
+
+ if (n_to_estim == 0) {
+ #--- All fixed, nothing to estimate
+ if (fill_empty_with_BareGround) {
+ veg_cover[ibar] <- 1 - sum(veg_cover[-ibar], na.rm = TRUE)
+
+ } else if (input_sum < 1) {
+ stop(
+ "'estimate_PotNatVeg_composition': ",
+ "User defined relative abundance values are all fixed, ",
+ "but their sum is smaller than 1 = full land cover."
+ )
+ }
+
+ } else if (n_to_estim == 1) {
+ #--- One value to estimate: difference from rest
+ veg_cover[ids_to_estim] <- 1 - input_sum
+ }
+
+ } else {
+ #---Potential natural vegetation
+ # i.e., (input_sum < 1 && sum(is.na(input_cover)) > 1) is TRUE;
+ # thus, estimate relative abundance fractions based on climate relationships
+
+ if (MAP_mm <= 1) {
+ # No precipitation ==> no vegetation, only bare-ground
+ # TODO: what about fog?
+ veg_cover[] <- 0
+ veg_cover[ibar] <- 1
+
+ } else {
+
+ estim_cover <- rep(NA, Nveg)
+
+ # Estimate climate variables
+ if (isNorth) {
+ Months_WinterTF <- c(12, 1:2)
+ Months_SummerTF <- 6:8
+ } else {
+ Months_WinterTF <- 6:8
+ Months_SummerTF <- c(12, 1:2)
+ }
+
+ # Fraction of precipitation falling during summer/winter months
+ ppt.SummerToMAP <- sum(mean_monthly_ppt_mm[Months_SummerTF]) / MAP_mm
+ ppt.WinterToMAP <- sum(mean_monthly_ppt_mm[Months_WinterTF]) / MAP_mm
+
+ # Temperature in July minus temperature in January
+ therm_amp <- mean_monthly_Temp_C[Months_SummerTF[2]] -
+ mean_monthly_Temp_C[Months_WinterTF[2]]
+
+ if (warn_extrapolation) {
+ # Adjust climate variables to limits underlying the data used to develop
+ # equations Paruelo & Lauenroth (1996): "The selected sites cover a
+ # range of MAT from 2 C to 21.2 C and a range of precipitation (MAP)
+ # from 117 to 1011 mm"
+
+ # MAT limits:
+ if (MAT_C < 1) {
+ # Note: MAT = 1 C as limit instead of 2 C based on empirical testing;
+ # also because log(x) is undefined for x < 0 and results in negative
+ # values for x < 1. Hence the threshold of 1.
+ warning(
+ "Equations used outside supported range (2 - 21.2 C): ",
+ "MAT = ", round(MAT_C, 2), " C reset to 1 C."
+ )
+ MAT_C <- 1
+ }
+
+ if (MAT_C > 21.2) {
+ warning(
+ "Equations used outside supported range (2 - 21.2 C): ",
+ "MAT = ", round(MAT_C, 2), " C."
+ )
+ }
+
+ if (MAP_mm < 117 || MAP_mm > 1011) {
+ warning(
+ "Equations used outside supported range (117-1011 mm): ",
+ "MAP = ", round(MAP_mm), " mm."
+ )
+ }
+ }
+
+
+ # 1. step: estimate relative abundance based on
+ # Paruelo & Lauenroth (1996): shrub climate-relationship:
+ if (MAP_mm < 1) {
+ estim_cover[ishr] <- 0
+ } else {
+ # if not enough winter precipitation for a given MAP, then equation
+ # results in negative values which we set to 0
+ estim_cover[ishr] <- rSW2utils::cut0Inf(
+ 1.7105 - 0.2918 * log(MAP_mm) + 1.5451 * ppt.WinterToMAP,
+ val = 0
+ )
+ }
+
+ # Paruelo & Lauenroth (1996): C4-grass climate-relationship:
+ if (MAT_C <= 0) {
+ estim_cover[igc4] <- 0
+ } else {
+ # if either MAT < 0 or not enough summer precipitation or
+ # too cold for a given MAP, then equation results in negative values
+ # which we set to 0
+ estim_cover[igc4] <- rSW2utils::cut0Inf(
+ -0.9837 + 0.000594 * MAP_mm +
+ 1.3528 * ppt.SummerToMAP + 0.2710 * log(MAT_C),
+ val = 0
+ )
+
+ # 2. step: Teeri JA, Stowe LG (1976)
+ # This equations give percent species/vegetation -> use to limit
+ # Paruelo's C4 equation, i.e., where no C4 species => C4 abundance == 0
+ do_c4_correction <- if (isTRUE(fix_issue218)) {
+ !is.null(dailyC4vars)
+ } else {
+ is.list(dailyC4vars) # always FALSE because `dailyC4vars` is vector
+ }
+
+ if (do_c4_correction) {
+ if (dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"] <= 0) {
+ grass_c4_species <- 0
+ } else {
+ x10 <- dailyC4vars["Month7th_NSadj_MinTemp_C"] * 9 / 5 + 32
+ x13 <- dailyC4vars["DegreeDaysAbove65F_NSadj_DaysC"] * 9 / 5
+ x18 <- log(dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"])
+ grass_c4_species <- as.numeric(
+ (1.60 * x10 + 0.0086 * x13 - 8.98 * x18 - 22.44) / 100
+ )
+ }
+
+ if (grass_c4_species <= rSW2_glovars[["tol"]]) {
+ estim_cover[igc4] <- 0
+ }
+ }
+ }
+
+ # Paruelo & Lauenroth (1996): C3-grass climate-relationship:
+ if (ppt.WinterToMAP <= 0) {
+ c3_in_grassland <- c3_in_shrubland <- NA
+ } else {
+ # if not enough winter precipitation or too warm for a
+ # given MAP, then equation results in negative values which we set to 0
+ c3_in_grassland <- rSW2utils::cut0Inf(
+ 1.1905 - 0.02909 * MAT_C + 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 1,
+ val = 0
+ )
+ c3_in_shrubland <- rSW2utils::cut0Inf(
+ 1.1905 - 0.02909 * MAT_C + 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 2,
+ val = 0
+ )
+ }
+
+ temp <- estim_cover[ishr] >= shrub_limit && !is.na(estim_cover[ishr])
+ estim_cover[igc3] <- ifelse(temp, c3_in_shrubland, c3_in_grassland)
+
+ # Paruelo & Lauenroth (1996): forb climate-relationship:
+ if (MAP_mm < 1 || MAT_C <= 0) {
+ estim_cover[ifor] <- NA
+ } else {
+ estim_cover[ifor] <- rSW2utils::cut0Inf(
+ -0.2035 + 0.07975 * log(MAP_mm) - 0.0623 * log(MAT_C),
+ val = 0
+ )
+ }
+
+ # Paruelo & Lauenroth (1996): succulent climate-relationship:
+ if (therm_amp <= 0 || ppt.WinterToMAP <= 0) {
+ estim_cover[isuc] <- NA
+ } else {
+ estim_cover[isuc] <- rSW2utils::cut0Inf(
+ -1 + 1.20246 * therm_amp ^ -0.0689 * ppt.WinterToMAP ^ -0.0322,
+ val = 0
+ )
+ }
+
+ # 3. step:
+ ngood <- sum(!is.na(estim_cover[iestim]))
+
+ # Any remaining NAs are set to 0
+ estim_cover[iestim] <- rSW2utils::replace_NAs_with_val(
+ x = estim_cover[iestim],
+ val_replace = 0
+ )
+
+ if (!fill_empty_with_BareGround && ngood <= 1) {
+ #--- Hack if some of the equations produced NAs:
+ # [these rules are made up arbitrarily by drs, Nov 2012]:
+ # If no or only one successful equation, then add
+ # 100% C3 if MAT < 10 C,
+ # 100% shrubs if MAP < 600 mm, and
+ # 100% C4 if MAT >= 10C & MAP >= 600 mm
+ if (MAP_mm < 600) {
+ estim_cover[ishr] <- 1 + estim_cover[ishr]
+ }
+
+ if (MAT_C < 10) {
+ estim_cover[igc3] <- 1 + estim_cover[igc3]
+ }
+
+ if (MAT_C >= 10 && MAP_mm >= 600) {
+ estim_cover[igc4] <- 1 + estim_cover[igc4]
+ }
+ }
+
+
+ # 4. step: put all together:
+ # 4-i) groups with set values (iset) and groups with estimable but
+ # fixed values (iestim & !is.na)
+ veg_cover[ifixed] <- input_cover[ifixed]
+
+ # 4-ii) rescale grass components to fixed total grass cover
+ if (fix_sumgrasses && add_sum_grasses > 0) {
+ ids_to_estim_grasses <- intersect(ids_to_estim, igrasses)
+ n_to_estim_grasses <- sum(ids_to_estim_grasses)
+
+ estim_grasses_cover_sum <- sum(estim_cover[ids_to_estim_grasses])
+
+ if (estim_grasses_cover_sum > 0) {
+ estim_cover[ids_to_estim_grasses] <-
+ estim_cover[ids_to_estim_grasses] *
+ add_sum_grasses / estim_grasses_cover_sum
+
+ } else if (n_to_estim_grasses > 0) {
+ # We estimated zero grass cover, but some was required
+ # --> divide requested amount evenly
+ estim_cover[ids_to_estim_grasses] <-
+ add_sum_grasses / n_to_estim_grasses
+
+ warning(
+ "'estimate_PotNatVeg_composition': ",
+ "Total grass cover set, but no grass cover estimated; ",
+ "requested cover evenly divided among grass types."
+ )
+ }
+ }
+
+ # 4-iii) groups with values to estimate (iestim & is.na):
+ veg_cover[ids_to_estim] <- estim_cover[ids_to_estim]
+
+ if (fix_sumgrasses) {
+ # Fix grasses and remove them from estimable
+ ifixed <- unique(c(ifixed, igrasses))
+ ids_to_estim <- setdiff(ids_to_estim, igrasses)
+ }
+
+ # Scale fractions to 0-1 with a sum equal to 1 (if needed)
+ tot_veg_cover_sum <- sum(veg_cover)
+
+ if (abs(tot_veg_cover_sum - 1) > rSW2_glovars[["tol"]]) {
+
+ estim_cover_sum <- sum(estim_cover[ids_to_estim])
+
+ if (estim_cover_sum > 0) {
+ # Scale estimable fractions so that total sums to 1, but
+ # scaling doesn't affect those that are fixed
+ veg_cover[ids_to_estim] <- veg_cover[ids_to_estim] *
+ (1 - sum(veg_cover[ifixed])) / estim_cover_sum
+
+ } else {
+ # cover to estimate is 0 and fixed_cover_sum < 1
+ if (fill_empty_with_BareGround && !fix_BareGround) {
+ # ==> fill land cover up with bare-ground
+ veg_cover[ibar] <- 1 - sum(veg_cover[-ibar])
+
+ } else {
+ stop(
+ "'estimate_PotNatVeg_composition': ",
+ "The estimated vegetation cover values are 0, ",
+ "the user fixed relative abundance values sum to less than 1, ",
+ "and bare-ground is fixed. ",
+ "Thus, the function cannot compute ",
+ "complete land cover composition."
+ )
+ }
+ }
+ }
+
+ }
+ }
+
+ names(veg_cover) <- veg_types
+
+ # Scale relative grass components to one (or set to 0)
+ c3c4ann <- veg_cover[igrasses]
+ grass_fraction <- sum(c3c4ann)
+
+ if (grass_fraction > 0) {
+ c3c4ann <- c3c4ann / grass_fraction
+ }
+
+ # Return values
+ temp <- unname(veg_cover)
+
+ list(
+ # Full resolution: suitable for STEPWAT2
+ Rel_Abundance_L0 = veg_cover,
+
+ # SOILWAT2 land cover types:
+ Rel_Abundance_L1 = c(
+ SW_TREES = temp[itre],
+ SW_SHRUB = temp[ishr],
+ SW_FORBS = temp[ifor] + temp[isuc],
+ SW_GRASS = grass_fraction,
+ SW_BAREGROUND = temp[ibar]
+ ),
+
+ # Relative contributions of sub-types to the grass type
+ Grasses = c3c4ann
+ )
+}
+
+
+
+## ------ Scanning of SOILWAT input text files ------
+readCharacter <- function(text, showWarnings = FALSE) {
+ .Deprecated("SOILWAT2's read functionality")
+ tmp <- strsplit(x = text, split = "\t")[[1]][1]
+ unlist(strsplit(x = tmp, split = " "))[1]
+}
+
+readInteger <- function(text,showWarnings=FALSE) {
+ .Deprecated("SOILWAT2's read functionality")
+ tmp <- suppressWarnings(as.integer(strsplit(x=text,split="\t")[[1]][1]))
+ if(is.na(tmp)) {
+ if(showWarnings) print(paste("Line: ",text,sep=""))
+ if(showWarnings) print("Not formatted with \t. Going to try [space].")
+ tmp <- suppressWarnings(as.integer(strsplit(x=text,split=" ")[[1]][1]))
+ if(is.na(tmp)) {
+ stop("Bad Line. Or Bad line numbers.")
+ }
+ }
+ return(tmp)
+}
+
+readLogical <- function(text,showWarnings=FALSE) {
+ .Deprecated("SOILWAT2's read functionality")
+ tmp <- suppressWarnings(as.logical(as.integer(strsplit(x=text,split="\t")[[1]][1])))
+ if(is.na(tmp)) {
+ if(showWarnings) print(paste("Line: ",text,sep=""))
+ if(showWarnings) print("Not formatted with \t. Going to try [space].")
+ tmp <- suppressWarnings(as.logical(as.integer(strsplit(x=text,split=" ")[[1]][1])))
+ if(is.na(tmp)) {
+ stop("Bad Line. Or Bad line numbers.")
+ }
+ }
+ return(tmp)
+}
+
+readNumeric <- function(text,showWarnings=FALSE) {
+ .Deprecated("SOILWAT2's read functionality")
+ tmp <- suppressWarnings(as.numeric(strsplit(x=text,split="\t")[[1]][1]))
+ if(is.na(tmp)) {
+ if(showWarnings) print(paste("Line: ",text,sep=""))
+ if(showWarnings) print("Not formatted with \t. Going to try [space].")
+ tmp <- suppressWarnings(as.numeric(strsplit(x=text,split=" ")[[1]][1]))
+ if(is.na(tmp)) {
+ stop("Bad Line. Or Bad line numbers.")
+ }
+ }
+ return(tmp)
+}
+
+readNumerics <- function(text,expectedArgs,showWarnings=FALSE) {
+ .Deprecated("SOILWAT2's read functionality")
+ tmp <- strsplit(x=text,split="\t")[[1]]
+ tmp <- tmp[tmp != ""] #get rid of extra spaces
+ if(length(tmp) > expectedArgs) tmp <- tmp[1:expectedArgs] #get rid of comment?
+ tmp <- suppressWarnings(as.numeric(tmp))
+ if(any(is.na(tmp))) {
+ if(showWarnings & any(is.na(tmp))) print(paste("Line: ",text,sep=""))
+ if(showWarnings & any(is.na(tmp))) print("Not formatted with \t. Going to try [space].")
+ tmp <- strsplit(x=text,split="\t")[[1]][1] #remove comment
+ tmp <- strsplit(x=tmp,split=" ")[[1]]
+ tmp <- tmp[tmp!=""] #remove extra spaces
+ tmp <- suppressWarnings(as.numeric(tmp[1:expectedArgs]))
+ if(any(is.na(tmp))) {
+ #last try. tried set by \t then by space. Now try both
+ tmp <- strsplit(x=text,split=" ",fixed=T)[[1]]
+ tmp <- unlist(strsplit(x=tmp,split="\t",fixed=T))
+ tmp <- tmp[tmp!=""] #remove extra spaces
+ tmp <- suppressWarnings(as.numeric(tmp[1:expectedArgs]))
+ if(any(is.na(tmp))) stop("Bad Line. Or Bad line numbers.")
+ }
+ }
+ if(length(tmp) != expectedArgs) {
+ if(showWarnings) print(paste("Line: ",text,sep=""))
+ stop(paste("Expected ",expectedArgs," Got ",length(tmp),sep=""))
+ }
+ return(tmp)
+}
diff --git a/R/swWeatherGenerator.R b/R/swWeatherGenerator.R
index 5d3f9e5f..5a983c0d 100644
--- a/R/swWeatherGenerator.R
+++ b/R/swWeatherGenerator.R
@@ -18,6 +18,13 @@
###############################################################################
+#' List daily weather variables incorporated in the weather generator
+#' @export
+weatherGenerator_dataColumns <- function() {
+ c("Tmax_C", "Tmin_C", "PPT_cm")
+}
+
+
#' Estimate coefficients for use by \var{SOILWAT2} weather generator
#'
#' Estimates coefficients for the two site-specific files
@@ -117,18 +124,27 @@
#' swMarkov_Conv(sw_in) <- res2[["mkv_woy"]]
#'
#' @export
-dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
- propagate_NAs = FALSE, valNA = NULL,
+dbW_estimate_WGen_coefs <- function(
+ weatherData,
+ WET_limit_cm = 0,
+ propagate_NAs = FALSE,
+ valNA = NULL,
imputation_type = c("none", "mean", "locf"),
- imputation_span = 5L) {
+ imputation_span = 5L
+) {
# daily weather data
- if (inherits(weatherData, "list") &&
- all(sapply(weatherData, inherits, what = "swWeatherData"))) {
- wdata <- data.frame(dbW_weatherData_to_dataframe(weatherData,
- valNA = valNA))
+ if (
+ inherits(weatherData, "list") &&
+ all(sapply(weatherData, inherits, what = "swWeatherData"))
+ ) {
+ wdata <- data.frame(
+ dbW_weatherData_to_dataframe(weatherData, valNA = valNA)
+ )
} else {
- wdata <- data.frame(set_missing_weather(weatherData, valNA = valNA))
+ wdata <- data.frame(
+ set_missing_weather(weatherData, valNA = valNA)
+ )
}
n_days <- nrow(wdata)
@@ -137,10 +153,13 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
na.rm <- !propagate_NAs
- #-----------------------------------------------------------------------------
#------ calculate mkv_prob.in
- icol_day <- grep("DOY|Day", colnames(wdata), ignore.case = TRUE,
- value = TRUE)
+ icol_day <- grep(
+ "DOY|Day",
+ colnames(wdata),
+ ignore.case = TRUE,
+ value = TRUE
+ )
#--- calculate WET days
wdata[["WET"]] <- wdata[["PPT_cm"]] > WET_limit_cm
@@ -156,25 +175,35 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
#--- output container: dataframe for storing mkv_prob.in data
doys <- 366 # see SOILWAT2 constant `MAX_DAYS`
outs <- c("DOY", "p_W_W", "p_W_D", "PPT_avg", "PPT_sd")
- mkv_prob <- data.frame(matrix(NA, nrow = doys, ncol = length(outs),
- dimnames = list(NULL, outs)))
+ mkv_prob <- data.frame(
+ matrix(nrow = doys, ncol = length(outs), dimnames = list(NULL, outs))
+ )
mkv_prob[, "DOY"] <- seq_len(doys)
#--- mean/sd of precipitation across years for doy i if it is a wet day
- temp <- by(wdata[, c("WET", "PPT_cm")], INDICES = wdata[, icol_day],
+ temp <- by(
+ wdata[, c("WET", "PPT_cm")],
+ INDICES = wdata[, icol_day],
function(x) {
# if `na.rm` is TRUE, then remove NAs in `WET`; if only NAs -> PPT_avg = 0
# if `na.rm` is FALSE, then any NA propagates to PPT_avg = NA
iswet <- if (na.rm) which(x[, "WET"]) else x[, "WET"]
ppt <- x[iswet, "PPT_cm"]
+
if (length(ppt) > 0) {
- c(PPT_avg = mean(ppt, na.rm = na.rm),
- PPT_sd = sd(ppt, na.rm = na.rm))
+ c(
+ PPT_avg = mean(ppt, na.rm = na.rm),
+ PPT_sd = sd(ppt, na.rm = na.rm)
+ )
} else {
# there are no wet days for this DOY; thus PPT = 0
- c(PPT_avg = 0, PPT_sd = 0)
+ c(
+ PPT_avg = 0,
+ PPT_sd = 0
+ )
}
- })
+ }
+ )
mkv_prob[, c("PPT_avg", "PPT_sd")] <- do.call(rbind, temp)
@@ -184,8 +213,10 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
# dryprob = p(wet|dry) = "p_W_D" #nolint
# = probability that it precipitates today if it was dry
# (did not precipitate) yesterday
- temp <- by(wdata[, c("WET", "WET_yesterday", "WW", "WD")],
- INDICES = wdata[, icol_day], function(x) {
+ temp <- by(
+ wdata[, c("WET", "WET_yesterday", "WW", "WD")],
+ INDICES = wdata[, icol_day],
+ function(x) {
# p(wet): probability that today is wet
p_W <- mean(x[, "WET"], na.rm = na.rm)
# number of DOY = i that follow a wet day
@@ -195,30 +226,34 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
c(
p_W_W = if (isTRUE(n_Wy > 0)) {
- # `p(wet|wet)` estimated as the number of years with doy being wet
- # given previous day is wet divided by the number of years with
- # the previous day being wet
- sum(x[, "WW"], na.rm = na.rm) / n_Wy
- } else {
- # `p(wet|wet)` approximated with frequency that today is wet for
- # data where yesterday is never wet (avoid division by zero);
- # this value is likely near 0 because p(wet yesterday) = 0
- # and p(wet today) ~ p(wet yesterday)
- p_W
- },
+ # `p(wet|wet)` estimated as the number of years with doy being wet
+ # given previous day is wet divided by the number of years with
+ # the previous day being wet
+ sum(x[, "WW"], na.rm = na.rm) / n_Wy
+ } else {
+ # `p(wet|wet)` approximated with frequency that today is wet for
+ # data where yesterday is never wet (avoid division by zero);
+ # this value is likely near 0 because p(wet yesterday) = 0
+ # and p(wet today) ~ p(wet yesterday)
+ p_W
+ },
+
p_W_D = if (isTRUE(n_Dy > 0)) {
- # `p(wet|dry)` estimated as the number of years with doy being wet
- # given previous day is dry divided by the number of years with
- # the previous day being dry
- sum(x[, "WD"], na.rm = na.rm) / n_Dy
- } else {
- # `p(wet|dry)` approximated with frequency that today is wet for
- # data where yesterday is never dry (avoid division by zero);
- # this value is likely near 1 because p(wet yesterday) = 1
- # and p(wet today) ~ p(wet yesterday)
- p_W
- })
- })
+ # `p(wet|dry)` estimated as the number of years with doy being wet
+ # given previous day is dry divided by the number of years with
+ # the previous day being dry
+ sum(x[, "WD"], na.rm = na.rm) / n_Dy
+ } else {
+ # `p(wet|dry)` approximated with frequency that today is wet for
+ # data where yesterday is never dry (avoid division by zero);
+ # this value is likely near 1 because p(wet yesterday) = 1
+ # and p(wet today) ~ p(wet yesterday)
+ p_W
+ }
+ )
+ }
+ )
+
mkv_prob[, c("p_W_W", "p_W_D")] <- do.call(rbind, temp)
#--- Make sure probability values are well formed: 0 <= p <= 1
@@ -242,7 +277,8 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
warning("Insufficient weather data to estimate ", msg)
} else {
message("Impute missing `mkv_prob` ", msg)
- mkv_prob <- rSW2utils::impute_df(mkv_prob,
+ mkv_prob <- rSW2utils::impute_df(
+ mkv_prob,
imputation_type = imputation_type,
imputation_span = imputation_span,
cyclic = TRUE
@@ -252,7 +288,6 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
- #-----------------------------------------------------------------------------
#------ mkv_covar.in
#--- week as interpreted by SOILWAT2 function `Doy2Week`
@@ -260,26 +295,43 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
#--- output container: dataframe for storing mkv_cov.in data
weeks <- 53 # see SOILWAT2 constant `MAX_WEEKS`
- outs <- c("WEEK", "wTmax_C", "wTmin_C",
+ outs <- c(
+ "WEEK", "wTmax_C", "wTmin_C",
"var_MAX", "cov_MAXMIN", "cov_MINMAX", "var_MIN",
- "CF_Tmax_wet", "CF_Tmax_dry", "CF_Tmin_wet", "CF_Tmin_dry")
- mkv_cov <- data.frame(matrix(NA, nrow = weeks, ncol = length(outs),
- dimnames = list(NULL, outs)))
+ "CF_Tmax_wet", "CF_Tmax_dry", "CF_Tmin_wet", "CF_Tmin_dry"
+ )
+ mkv_cov <- data.frame(
+ matrix(nrow = weeks, ncol = length(outs), dimnames = list(NULL, outs))
+ )
#--- Aggregate for each week
mkv_cov[, "WEEK"] <- seq_len(weeks)
# Average weekly temperature values
- mkv_cov[, "wTmax_C"] <- tapply(wdata[["Tmax_C"]], wdata[["WEEK"]], mean,
- na.rm = na.rm)
- mkv_cov[, "wTmin_C"] <- tapply(wdata[["Tmin_C"]], wdata[["WEEK"]], mean,
- na.rm = na.rm)
+ mkv_cov[, "wTmax_C"] <- tapply(
+ wdata[["Tmax_C"]],
+ wdata[["WEEK"]],
+ mean,
+ na.rm = na.rm
+ )
+
+ mkv_cov[, "wTmin_C"] <- tapply(
+ wdata[["Tmin_C"]],
+ wdata[["WEEK"]],
+ mean,
+ na.rm = na.rm
+ )
# Variance-covariance values among maximum and minimum temperature
- temp <- by(wdata[, c("Tmax_C", "Tmin_C")], wdata[["WEEK"]], cov,
- use = if (na.rm) "na.or.complete" else "everything")
+ temp <- by(
+ wdata[, c("Tmax_C", "Tmin_C")],
+ wdata[["WEEK"]],
+ cov,
+ use = if (na.rm) "na.or.complete" else "everything"
+ )
temp <- sapply(temp, function(x) c(x[1, 1], x[1, 2], x[2, 1], x[2, 2]))
+
mkv_cov[, "var_MAX"] <- temp[1, ]
mkv_cov[, "cov_MAXMIN"] <- temp[2, ]
mkv_cov[, "cov_MINMAX"] <- temp[3, ]
@@ -290,20 +342,24 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
# Used to correct random temperature values based on average conditions
# if that target day is wet or dry (e.g., overcast weather tends to
# increase minimum daily temperature and decrease maximum daily tempature)
- temp <- by(wdata[, c("WET", "Tmax_C", "Tmin_C")], INDICES = wdata[, "WEEK"],
+ temp <- by(
+ wdata[, c("WET", "Tmax_C", "Tmin_C")],
+ INDICES = wdata[, "WEEK"],
function(x) {
# if `na.rm` is TRUE, then consider `WET` = NA as FALSE
# if `na.rm` is FALSE, then propagate NAs in `WET` -> neither wet nor dry
iswet <- if (na.rm) {
- which_wet <- which(x[, "WET"]) # numeric vector
- out <- rep(FALSE, length(x[, "WET"]))
- # only days where 'WET' is TRUE are considered wet
- out[which_wet] <- TRUE
- out # logical vector same length as x[, "WET"]
- } else {
- x[, "WET"] # logical vector
- }
+ which_wet <- which(x[, "WET"]) # numeric vector
+ out <- rep(FALSE, length(x[, "WET"]))
+ # only days where 'WET' is TRUE are considered wet
+ out[which_wet] <- TRUE
+ out # logical vector same length as x[, "WET"]
+ } else {
+ x[, "WET"] # logical vector
+ }
+
isanywet <- isTRUE(any(iswet, na.rm = na.rm))
+
# previously isdry became all FALSE if na.rm = TRUE (because then iswet
# was numeric vector with all positive digits)
isdry <- !iswet
@@ -311,26 +367,27 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
# if no wet/dry days in week of year, then use overall mean instead
# of conditional mean (i.e., given wet/dry)
- c(Tmax_mean_wet = if (isanywet) {
- mean(x[iswet, "Tmax_C"], na.rm = na.rm)
- } else {
- mean(x[, "Tmax_C"], na.rm = na.rm)
- },
+ c(
+ Tmax_mean_wet = if (isanywet) {
+ mean(x[iswet, "Tmax_C"], na.rm = na.rm)
+ } else {
+ mean(x[, "Tmax_C"], na.rm = na.rm)
+ },
Tmax_mean_dry = if (isanydry) {
- mean(x[isdry, "Tmax_C"], na.rm = na.rm)
- } else {
- mean(x[, "Tmax_C"], na.rm = na.rm)
- },
+ mean(x[isdry, "Tmax_C"], na.rm = na.rm)
+ } else {
+ mean(x[, "Tmax_C"], na.rm = na.rm)
+ },
Tmin_mean_wet = if (isanywet) {
- mean(x[iswet, "Tmin_C"], na.rm = na.rm)
- } else {
- mean(x[, "Tmin_C"], na.rm = na.rm)
- },
+ mean(x[iswet, "Tmin_C"], na.rm = na.rm)
+ } else {
+ mean(x[, "Tmin_C"], na.rm = na.rm)
+ },
Tmin_mean_dry = if (isanydry) {
- mean(x[isdry, "Tmin_C"], na.rm = na.rm)
- } else {
- mean(x[, "Tmin_C"], na.rm = na.rm)
- }
+ mean(x[isdry, "Tmin_C"], na.rm = na.rm)
+ } else {
+ mean(x[, "Tmin_C"], na.rm = na.rm)
+ }
)
}
)
@@ -355,7 +412,8 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
warning("Insufficient weather data to estimate ", msg)
} else {
message("Impute missing `mkv_cov` ", msg)
- mkv_cov <- rSW2utils::impute_df(mkv_cov,
+ mkv_cov <- rSW2utils::impute_df(
+ mkv_cov,
imputation_type = imputation_type,
imputation_span = imputation_span,
cyclic = TRUE
@@ -374,6 +432,10 @@ dbW_estimate_WGen_coefs <- function(weatherData, WET_limit_cm = 0,
#' \code{\link{dbW_estimate_WGen_coefs}}.
#' @param mkv_woy A data.frame. The same named output element of
#' \code{\link{dbW_estimate_WGen_coefs}}.
+#' @param path A character string. The path on disk to the location
+#' where output files should be created.
+#' @param digits An integer value. The number of digits with which to write
+#' the values to disk.
#'
#' @seealso \code{\link{dbW_estimate_WGen_coefs}} to
#' calculate the necessary values based on daily weather data.
@@ -432,8 +494,11 @@ check_weather <- function(weather, required_variables) {
}
# Aggregate daily weather for each time step
-prepare_weather <- function(data_daily,
- time_steps = c("Year", "Month", "Week", "Day"), na.rm = FALSE) {
+prepare_weather <- function(
+ data_daily,
+ time_steps = c("Year", "Month", "Week", "Day"),
+ na.rm = FALSE
+) {
weather_list <- list()
id_daily <- "Day" == time_steps
@@ -447,8 +512,11 @@ prepare_weather <- function(data_daily,
}
# Prepare weather data object for \code{\link{compare_dailyweather}}
-prepare_weather_for_comparison <- function(weather,
- time_steps = c("Year", "Month", "Week", "Day"), na.rm = FALSE) {
+prepare_weather_for_comparison <- function(
+ weather,
+ time_steps = c("Year", "Month", "Week", "Day"),
+ na.rm = FALSE
+) {
req_vars <- c("Year", "Tmax_C", "Tmin_C", "PPT_cm")
if (length(weather) == length(time_steps) &&
@@ -608,9 +676,11 @@ compare_weather <- function(
}
)
- array(unlist(temp),
+ array(
+ unlist(temp),
dim = c(2, length(data), length(time_steps), length(weather_vars)),
- dimnames = list(c("mean", "sd"), names(data), time_steps, weather_vars))
+ dimnames = list(c("mean", "sd"), names(data), time_steps, weather_vars)
+ )
}
foo_bxp <- function(data, ref_data, ylab, legend = FALSE) {
@@ -622,12 +692,22 @@ compare_weather <- function(
if (all(is.finite(ylim))) {
graphics::boxplot(data, ylim = ylim, ylab = ylab)
- graphics::points(seq_along(ref_data), ref_data, col = "red", pch = 4,
- lwd = 2)
+ graphics::points(
+ seq_along(ref_data),
+ ref_data,
+ col = "red",
+ pch = 4,
+ lwd = 2
+ )
if (legend) {
- graphics::legend("topright", legend = c("Reference", "Weather"),
- col = c("red", "black"), pch = c(4, 16), pt.lwd = 2)
+ graphics::legend(
+ "topright",
+ legend = c("Reference", "Weather"),
+ col = c("red", "black"),
+ pch = c(4, 16),
+ pt.lwd = 2
+ )
}
} else {
@@ -642,32 +722,54 @@ compare_weather <- function(
# Make figure
panels <- c(3, 2)
- grDevices::png(units = "in", res = 150,
- height = 3 * panels[1], width = 6 * panels[2],
- file = file.path(path, paste0(tag, "_CompareWeather_Boxplots_MeanSD.png")))
- par_prev <- graphics::par(mfrow = panels, mar = c(2, 2.5, 0.5, 0.5),
- mgp = c(1, 0, 0), tcl = 0.3, cex = 1)
+ grDevices::png(
+ units = "in",
+ res = 150,
+ height = 3 * panels[1],
+ width = 6 * panels[2],
+ file = file.path(path, paste0(tag, "_CompareWeather_Boxplots_MeanSD.png"))
+ )
+ par_prev <- graphics::par(
+ mfrow = panels,
+ mar = c(2, 2.5, 0.5, 0.5),
+ mgp = c(1, 0, 0),
+ tcl = 0.3,
+ cex = 1
+ )
- foo_bxp(data = comp_MeanSD["mean", , , "PPT_cm"],
+ foo_bxp(
+ data = comp_MeanSD["mean", , , "PPT_cm"],
ref_data = ref_MeanSD["mean", , , "PPT_cm"],
- ylab = "Mean Precipitation (cm)", legend = TRUE)
- foo_bxp(data = comp_MeanSD["sd", , , "PPT_cm"],
+ ylab = "Mean Precipitation (cm)",
+ legend = TRUE
+ )
+ foo_bxp(
+ data = comp_MeanSD["sd", , , "PPT_cm"],
ref_data = ref_MeanSD["sd", , , "PPT_cm"],
- ylab = "SD Precipitation (cm)")
+ ylab = "SD Precipitation (cm)"
+ )
- foo_bxp(data = comp_MeanSD["mean", , , "Tmax_C"],
+ foo_bxp(
+ data = comp_MeanSD["mean", , , "Tmax_C"],
ref_data = ref_MeanSD["mean", , , "Tmax_C"],
- ylab = "Mean Daily Max Temperature (C)")
- foo_bxp(data = comp_MeanSD["sd", , , "Tmax_C"],
+ ylab = "Mean Daily Max Temperature (C)"
+ )
+ foo_bxp(
+ data = comp_MeanSD["sd", , , "Tmax_C"],
ref_data = ref_MeanSD["sd", , , "Tmax_C"],
- ylab = "SD Daily Max Temperature (C)")
+ ylab = "SD Daily Max Temperature (C)"
+ )
- foo_bxp(data = comp_MeanSD["mean", , , "Tmin_C"],
+ foo_bxp(
+ data = comp_MeanSD["mean", , , "Tmin_C"],
ref_data = ref_MeanSD["mean", , , "Tmin_C"],
- ylab = "Mean Daily Min Temperature (C)")
- foo_bxp(data = comp_MeanSD["sd", , , "Tmin_C"],
+ ylab = "Mean Daily Min Temperature (C)"
+ )
+ foo_bxp(
+ data = comp_MeanSD["sd", , , "Tmin_C"],
ref_data = ref_MeanSD["sd", , , "Tmin_C"],
- ylab = "SD Daily Min Temperature (C)")
+ ylab = "SD Daily Min Temperature (C)"
+ )
graphics::par(par_prev)
grDevices::dev.off()
@@ -676,33 +778,62 @@ compare_weather <- function(
#--- Quantile-quantile comparisons: scatterplots
foo_qq <- function(data, ref_data, var, time, lab, legend = FALSE) {
- vlim <- range(sapply(c(ref_data, data),
- function(x) range(x[[time]][, var], na.rm = TRUE)))
+ vlim <- range(
+ sapply(
+ c(ref_data, data),
+ function(x) range(x[[time]][, var], na.rm = TRUE)
+ )
+ )
if (all(is.finite(vlim))) {
probs <- seq(0, 1, length.out = 1000)
- x <- quantile(ref_data[[1]][[time]][, var], probs = probs,
- na.rm = TRUE)
- graphics::plot(x, x, type = "n", xlim = vlim, ylim = vlim, asp = 1,
+ x <- quantile(
+ ref_data[[1]][[time]][, var], probs = probs,
+ na.rm = TRUE
+ )
+ graphics::plot(
+ x,
+ x,
+ type = "n",
+ xlim = vlim,
+ ylim = vlim,
+ asp = 1,
xlab = paste0(time, "ly : reference ", lab),
- ylab = paste0(time, "ly : weather ", lab))
+ ylab = paste0(time, "ly : weather ", lab)
+ )
+
for (k in seq_along(data)) {
- qy <- quantile(data[[k]][[time]][, var], probs = probs,
- na.rm = TRUE)
+ qy <- quantile(
+ data[[k]][[time]][, var], probs = probs,
+ na.rm = TRUE
+ )
graphics::points(x, qy, pch = 46)
}
graphics::abline(h = 0, lty = 2)
graphics::abline(v = 0, lty = 2)
- graphics::segments(x0 = vlim[1], y0 = vlim[1],
- x1 = vlim[2], y1 = vlim[2], col = "red", lwd = 2)
+ graphics::segments(
+ x0 = vlim[1],
+ y0 = vlim[1],
+ x1 = vlim[2],
+ y1 = vlim[2],
+ col = "red",
+ lwd = 2
+ )
if (legend) {
- graphics::legend("topleft", legend = c("Reference", "Weather"),
- col = c("red", "black"), pch = c(NA, 16), pt.lwd = 2,
- lty = c(1, NA), lwd = 2, merge = TRUE)
+ graphics::legend(
+ "topleft",
+ legend = c("Reference", "Weather"),
+ col = c("red", "black"),
+ pch = c(NA, 16),
+ pt.lwd = 2,
+ lty = c(1, NA),
+ lwd = 2,
+ merge = TRUE
+ )
}
} else {
@@ -712,19 +843,44 @@ compare_weather <- function(
# Make figure
panels <- c(length(time_steps), 3)
- grDevices::png(units = "in", res = 150,
- height = 3 * panels[1], width = 3 * panels[2],
- file = file.path(path, paste0(tag, "_CompareWeather_QQplots.png")))
- par_prev <- graphics::par(mfrow = panels, mar = c(2, 2.5, 0.5, 0.5),
- mgp = c(1, 0, 0), tcl = 0.3, cex = 1)
+ grDevices::png(
+ units = "in",
+ res = 150,
+ height = 3 * panels[1],
+ width = 3 * panels[2],
+ file = file.path(path, paste0(tag, "_CompareWeather_QQplots.png"))
+ )
+ par_prev <- graphics::par(
+ mfrow = panels,
+ mar = c(2, 2.5, 0.5, 0.5),
+ mgp = c(1, 0, 0),
+ tcl = 0.3,
+ cex = 1
+ )
for (ts in time_steps) {
- foo_qq(comp_df, ref_df, var = "PPT_cm", time = ts,
- lab = "precipitation (cm)", legend = ts == time_steps[1])
- foo_qq(comp_df, ref_df, var = "Tmax_C", time = ts,
- lab = "max temp (C)")
- foo_qq(comp_df, ref_df, var = "Tmin_C", time = ts,
- lab = "min temp (C)")
+ foo_qq(
+ comp_df,
+ ref_df,
+ var = "PPT_cm",
+ time = ts,
+ lab = "precipitation (cm)",
+ legend = ts == time_steps[1]
+ )
+ foo_qq(
+ comp_df,
+ ref_df,
+ var = "Tmax_C",
+ time = ts,
+ lab = "max temp (C)"
+ )
+ foo_qq(
+ comp_df,
+ ref_df,
+ var = "Tmin_C",
+ time = ts,
+ lab = "min temp (C)"
+ )
}
graphics::par(par_prev)
@@ -760,11 +916,21 @@ compare_weather <- function(
rep(ceiling(sqrt(length(vars))), 2)
}
- grDevices::png(units = "in", res = 150,
- height = 3 * panels[1], width = 3 * panels[2],
- file = fname)
- par_prev <- graphics::par(mfrow = panels, mar = c(2, 2.5, 0.5, 0.5),
- mgp = c(1, 0, 0), tcl = 0.3, cex = 1)
+ grDevices::png(
+ units = "in",
+ res = 150,
+ height = 3 * panels[1],
+ width = 3 * panels[2],
+ file = fname
+ )
+
+ par_prev <- graphics::par(
+ mfrow = panels,
+ mar = c(2, 2.5, 0.5, 0.5),
+ mgp = c(1, 0, 0),
+ tcl = 0.3,
+ cex = 1
+ )
for (v in vars) {
x <- ref_data[[obj]][, v]
@@ -775,22 +941,43 @@ compare_weather <- function(
)
if (all(is.finite(vlim_obs)) && all(is.finite(vlim))) {
- graphics::plot(x, x, type = "n", xlim = vlim, ylim = vlim, asp = 1,
- xlab = paste0("Reference ", v), ylab = paste0("Weather ", v))
+ graphics::plot(
+ x,
+ x,
+ type = "n",
+ xlim = vlim,
+ ylim = vlim,
+ asp = 1,
+ xlab = paste0("Reference ", v),
+ ylab = paste0("Weather ", v)
+ )
+
for (k in seq_along(data)) {
isgood <- complete.cases(cbind(x, data[[k]][[obj]][, v]))
- graphics::lines(stats::lowess(x[isgood], data[[k]][[obj]][isgood, v]),
- col = "gray")
+ graphics::lines(
+ stats::lowess(x[isgood], data[[k]][[obj]][isgood, v]),
+ col = "gray"
+ )
}
graphics::abline(h = 0, lty = 2)
graphics::abline(v = 0, lty = 2)
- graphics::segments(x0 = vlim_obs[1], y0 = vlim_obs[1],
- x1 = vlim_obs[2], y1 = vlim_obs[2], col = "red", lwd = 2)
+ graphics::segments(
+ x0 = vlim_obs[1],
+ y0 = vlim_obs[1],
+ x1 = vlim_obs[2],
+ y1 = vlim_obs[2],
+ col = "red",
+ lwd = 2
+ )
if (v == vars[1]) {
- graphics::legend("topleft", legend = c("Reference", "Weather"),
- col = c("red", "black"), lwd = 2)
+ graphics::legend(
+ "topleft",
+ legend = c("Reference", "Weather"),
+ col = c("red", "black"),
+ lwd = 2
+ )
}
} else {
@@ -803,12 +990,25 @@ compare_weather <- function(
}
- foo_scatter_wgin(data = comp_wgin, ref_data = ref_wgin, obj = "mkv_doy",
- fname = file.path(path,
- paste0(tag, "_CompareWeather_WGenInputs_DayOfYear.png")))
- foo_scatter_wgin(data = comp_wgin, ref_data = ref_wgin, obj = "mkv_woy",
- fname = file.path(path,
- paste0(tag, "_CompareWeather_WGenInputs_WeekOfYear.png")))
+ foo_scatter_wgin(
+ data = comp_wgin,
+ ref_data = ref_wgin,
+ obj = "mkv_doy",
+ fname = file.path(
+ path,
+ paste0(tag, "_CompareWeather_WGenInputs_DayOfYear.png")
+ )
+ )
+
+ foo_scatter_wgin(
+ data = comp_wgin,
+ ref_data = ref_wgin,
+ obj = "mkv_woy",
+ fname = file.path(
+ path,
+ paste0(tag, "_CompareWeather_WGenInputs_WeekOfYear.png")
+ )
+ )
}
@@ -821,6 +1021,8 @@ compare_weather <- function(
#' @inheritParams dbW_estimate_WGen_coefs
#' @param years An integer vector. The calendar years for which to generate
#' daily weather. If \code{NULL}, then extracted from \code{weatherData}.
+#' @param digits An integer value. The returned values will be rounded to
+#' the specified number of decimal places.
#' @param wgen_coeffs A list with two named elements \var{mkv_doy} and
#' \var{mkv_woy}, i.e., the return value of
#' \code{\link{dbW_estimate_WGen_coefs}}. If \code{NULL}, then determined
@@ -830,6 +1032,14 @@ compare_weather <- function(
#'
#' @return A list of elements of class \code{\linkS4class{swWeatherData}}.
#'
+#' @section Details:
+#' The current implementation of the weather generator produces values
+#' only for variables in [weatherGenerator_dataColumns()].
+#' Values are generated for those days where at least one of the implemented
+#' variables is missing; if any value is missing, then values for that day of
+#' all implemented variables will be replaced by those produced
+#' by the weather generator.
+#'
#' @examples
#' # Load data for 1949-2010
#' wdata <- data.frame(dbW_weatherData_to_dataframe(rSOILWAT2::weatherData))
@@ -864,7 +1074,7 @@ compare_weather <- function(
#'
#' ## Example 3: generate weather based only on estimated weather generator
#' ## coefficients from a different dataset
-#' x_empty <- list(new("swWeatherData"))
+#' x_empty <- weatherHistory()
#' wout3 <- dbW_generateWeather(
#' x_empty,
#' years = 2050:2055,
@@ -883,13 +1093,22 @@ compare_weather <- function(
#' )
#' unlink(list.files(path), force = TRUE)
#'
+#' @md
#' @export
-dbW_generateWeather <- function(weatherData, years = NULL, wgen_coeffs = NULL,
- imputation_type = "mean", imputation_span = 5L, seed = NULL) {
+dbW_generateWeather <- function(
+ weatherData,
+ years = NULL,
+ wgen_coeffs = NULL,
+ imputation_type = "mean",
+ imputation_span = 5L,
+ digits = 4L,
+ seed = NULL
+) {
#--- Obtain missing/null arguments
if (is.null(wgen_coeffs)) {
- wgen_coeffs <- dbW_estimate_WGen_coefs(weatherData,
+ wgen_coeffs <- dbW_estimate_WGen_coefs(
+ weatherData,
propagate_NAs = FALSE,
imputation_type = imputation_type,
imputation_span = imputation_span
@@ -897,48 +1116,47 @@ dbW_generateWeather <- function(weatherData, years = NULL, wgen_coeffs = NULL,
}
if (is.data.frame(weatherData)) {
- weatherData <- dbW_dataframe_to_weatherData(weatherData)
+ weatherData <- dbW_dataframe_to_weatherData(
+ weatherData,
+ round = digits + 2L
+ )
}
if (is.null(years)) {
years <- get_years_from_weatherData(weatherData)
}
- #--- Put rSOILWAT2 run together to produce imputed daily weather
+ #--- Put rSOILWAT2 input object together to produce imputed daily weather
sw_in <- rSOILWAT2::sw_exampleData
# Set years
- swWeather_FirstYearHistorical(sw_in) <- min(years)
swYears_EndYear(sw_in) <- max(years)
swYears_StartYear(sw_in) <- min(years)
- # Set weather data
- set_WeatherHistory(sw_in) <- weatherData
-
- # Turn on weather generator
+ # Turn on weather generator (to fill in missing values)
swWeather_UseMarkov(sw_in) <- TRUE
+ swWeather_UseMarkovOnly(sw_in) <- FALSE
# Set weather generator coefficients
swMarkov_Prob(sw_in) <- wgen_coeffs[["mkv_doy"]]
swMarkov_Conv(sw_in) <- wgen_coeffs[["mkv_woy"]]
- # Turn off CO2-effects to avoid any issues
- swCarbon_Use_Bio(sw_in) <- 0
- swCarbon_Use_WUE(sw_in) <- 0
+ # Turn off monthly use flags
+ sw_in@weather@use_cloudCoverMonthly <- FALSE
+ sw_in@weather@use_humidityMonthly <- FALSE
+ sw_in@weather@use_windSpeedMonthly <- FALSE
- #--- Execute SOILWAT2 to generate weather
- set.seed(seed)
- sw_out <- sw_exec(inputData = sw_in)
+ # Specify available daily input variables
+ # and prescribe Tmax, Tmin, PPT
+ dif <- calc_dailyInputFlags(weatherData)
+ dif[weatherGenerator_dataColumns()] <- TRUE
+ sw_in@weather@dailyInputFlags <- dif
- #--- Extract weather generator imputed daily weather
- xdf <- slot(slot(sw_out, "TEMP"), "Day")[, c("Year", "Day", "max_C", "min_C")]
- colnames(xdf) <- c("Year", "DOY", "Tmax_C", "Tmin_C")
- xdf <- data.frame(
- xdf,
- PPT_cm = slot(slot(sw_out, "PRECIP"), "Day")[, "ppt"]
+ #--- Process weather in SOILWAT2
+ set.seed(seed)
+ dbW_weatherData_round(
+ .Call(C_rSW2_processAllWeather, weatherData, sw_in),
+ digits = digits
)
-
- # Convert to rSOILWAT2 weather data format
- dbW_dataframe_to_weatherData(xdf)
}
diff --git a/R/sw_Miscellaneous_Functions.R b/R/sw_Miscellaneous_Functions.R
index 2b242246..3286206f 100644
--- a/R/sw_Miscellaneous_Functions.R
+++ b/R/sw_Miscellaneous_Functions.R
@@ -1,115 +1,3 @@
-#' 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.
-#'
-#' @export
-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, sd))
- temp <- c("Month7th_NSadj_MinTemp_C",
- "LengthFreezeFreeGrowingPeriod_NSadj_Days",
- "DegreeDaysAbove65F_NSadj_DaysC")
- names(res) <- c(temp, paste0(temp, ".sd"))
-
- res
-}
-
-#' Calculate climate variables required to estimate percent cheatgrass cover
-#' in North America
-#'
-#' @section Note: This function does not correct for northern/southern
-#' hemisphere.
-#'
-#' @param monthlyPPT_cm A numeric matrix of monthly precipitation values in
-#' centimeter. There are 12 rows, one for each month of the year;
-#' and there is one column for each year.
-#' @param monthlyTempMean_C A numeric matrix of monthly mean temperature values
-#' in degree Celsius. There are 12 rows, one for each month of the year;
-#' and there is one column for each year.
-#' @param monthlyTempMin_C A numeric matrix of monthly minimum temperature
-#' value sin degree Celsius. There are 12 rows, one for each month of the
-#' year; and there is one column for each year.
-#'
-#' @return A named numeric vector of length 6 with mean and standard deviation
-#' for \var{Month7th_PPT_mm}, \var{MeanTemp_ofDriestQuarter_C}, and
-#' \var{MinTemp_of2ndMonth_C}.
-#'
-#' @references Brummer, T. J., K. T. Taylor, J. Rotella, B. D. Maxwell,
-#' L. J. Rew, and M. Lavin. 2016. Drivers of Bromus tectorum Abundance in
-#' the Western North American Sagebrush Steppe. Ecosystems 19:986-1000.
-#'
-#' @export
-sw_Cheatgrass_ClimVar <- function(monthlyPPT_cm,
- monthlyTempMean_C = NULL, monthlyTempMin_C = NULL) {
-
- # Mean precipitation sum of seventh month of the season (i.e.,
- # July in northern hemisphere)
- Month7th_PPT_mm <- 10 * monthlyPPT_cm[7, ]
- nyrs <- seq_along(Month7th_PPT_mm)
-
- # Mean temperature of driest quarter (Bioclim variable 9)
- # see \code{link[dismo]{biovars}}
- if (!is.null(monthlyTempMean_C)) {
- wet <- t(apply(monthlyPPT_cm, 2, rSW2utils::moving_function,
- k = 3, win_fun = sum, na.rm = TRUE, circular = TRUE
- ))
- tmp <- t(apply(monthlyTempMean_C, 2, rSW2utils::moving_function,
- k = 3, win_fun = mean, na.rm = TRUE, circular = TRUE
- ))
- dryqrt <- cbind(
- seq_len(ncol(monthlyPPT_cm)),
- as.integer(apply(wet, 1, which.min))
- )
- MeanTemp_ofDriestQuarter_C <- tmp[dryqrt]
-
- } else {
- MeanTemp_ofDriestQuarter_C <- rep(NA, length(Month7th_PPT_mm))
- }
-
- # Minimum February temperature
- if (!is.null(monthlyTempMin_C)) {
- MinTemp_of2ndMonth_C <- monthlyTempMin_C[2, , ]
- } else {
- MinTemp_of2ndMonth_C <- rep(NA, length(Month7th_PPT_mm))
- }
-
-
- # Aggregate
- temp <- cbind(
- Month7th_PPT_mm[nyrs],
- MeanTemp_ofDriestQuarter_C[nyrs],
- MinTemp_of2ndMonth_C[nyrs]
- )
-
- res <- c(apply(temp, 2, mean), apply(temp, 2, sd))
- temp <- c("Month7th_PPT_mm", "MeanTemp_ofDriestQuarter_C",
- "MinTemp_of2ndMonth_C")
- 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
@@ -174,108 +62,48 @@ calc_SiteClimate <- function(weatherList, year.start = NA, year.end = NA,
do_C4vars = FALSE, do_Cheatgrass_ClimVars = FALSE, simTime2 = NULL,
latitude = 90) {
- x <- dbW_weatherData_to_dataframe(weatherList)
-
- # Trim to requested years
- if (!is.na(year.start)) {
- x <- x[x[, "Year"] >= year.start, ]
- } else {
- year.start <- x[1, "Year"]
- }
-
- if (!is.na(year.end)) {
- x <- x[x[, "Year"] <= year.end, ]
- } else {
- year.end <- x[nrow(x), "Year"]
- }
-
- years <- unique(x[, "Year"])
-
- if (length(years) == 0) {
- stop("'calc_SiteClimate': no weather data available for ",
- "requested range of years")
- }
-
- # Mean daily temperature
- Tmean_C <- rowMeans(x[, c("Tmax_C", "Tmin_C")])
+ x <- dbW_weatherData_to_dataframe(weatherList)
- # Get time sequence information
- is_simTime2_good <- !is.null(simTime2) &&
- identical(years, simTime2[["useyrs_NSadj"]]) &&
- !is.null(simTime2[["month_ForEachUsedDay"]])
-
- is_simTime2_good_for_C4vars <- if (do_C4vars) {
- if (is_simTime2_good) {
- !is.null(simTime2[["month_ForEachUsedDay_NSadj"]]) &&
- !is.null(simTime2[["year_ForEachUsedDay_NSadj"]])
+ # Trim to requested years
+ if (!is.na(year.start)) {
+ x <- x[x[, "Year"] >= year.start, ]
} else {
- FALSE
+ year.start <- x[1, "Year"]
}
- } else {
- TRUE
- }
-
- if (is_simTime2_good && is_simTime2_good_for_C4vars) {
- st2 <- simTime2
- } else {
- st2 <- rSW2data::simTiming_ForEachUsedTimeUnit(
- useyrs = years,
- sim_tscales = "daily",
- latitude = latitude,
- account_NorthSouth = do_C4vars
- )
- }
-
- # Calculate monthly values
- index <- st2[["month_ForEachUsedDay"]] + 100 * x[, "Year"]
-
- mon_Temp <- vapply(
- list(Tmean_C, x[, "Tmin_C"], x[, "Tmax_C"]),
- function(data) matrix(tapply(data, index, mean, na.rm = TRUE), nrow = 12),
- FUN.VALUE = matrix(NA_real_, nrow = 12, ncol = length(years))
- )
-
- mon_PPT <- matrix(tapply(x[, "PPT_cm"], index, sum, na.rm = TRUE), nrow = 12)
+ if (!is.na(year.end)) {
+ x <- x[x[, "Year"] <= year.end, ]
+ } else {
+ year.end <- x[nrow(x), "Year"]
+ }
- list(
- # Calculate mean monthly values
- meanMonthlyTempC = apply(mon_Temp[, , 1, drop = FALSE], 1, mean,
- na.rm = TRUE),
- minMonthlyTempC = apply(mon_Temp[, , 2, drop = FALSE], 1, mean,
- na.rm = TRUE),
- maxMonthlyTempC = apply(mon_Temp[, , 3, drop = FALSE], 1, mean,
- na.rm = TRUE),
- meanMonthlyPPTcm = apply(mon_PPT, 1, mean, na.rm = TRUE),
+ years <- unique(x[, "Year"])
- # Calculate mean annual values
- MAP_cm = sum(mon_PPT, na.rm = TRUE) / length(years),
- MAT_C = mean(Tmean_C, na.rm = TRUE),
+ if (length(years) == 0) {
+ stop("'calc_SiteClimate': no weather data available for ",
+ "requested range of years")
+ }
- # If C4-variables are requested
- dailyTempMin = if (do_C4vars) x[, "Tmin_C"] else NA,
- dailyTempMean = if (do_C4vars) Tmean_C else NA,
- dailyC4vars = if (do_C4vars) {
- sw_dailyC4_TempVar(
- dailyTempMin = x[, "Tmin_C"],
- dailyTempMean = Tmean_C,
- simTime2 = st2
+ res <- .Call(C_rSW2_calc_SiteClimate,
+ weatherList,
+ year.start,
+ year.end,
+ do_C4vars,
+ do_Cheatgrass_ClimVars,
+ latitude
)
- } else {
- NA
- },
- # If cheatgrass-variables are requested
- Cheatgrass_ClimVars = if (do_Cheatgrass_ClimVars) {
- sw_Cheatgrass_ClimVar(
- monthlyPPT_cm = mon_PPT,
- monthlyTempMean_C = mon_Temp[, , 1, drop = FALSE],
- monthlyTempMin_C = mon_Temp[, , 2, drop = FALSE]
- )
- } else {
- NA
- }
- )
+ res[["dailyTempMin"]] <- if (do_C4vars) x[, "Tmin_C"] else NA
+ res[["dailyTempMean"]] <- if (do_C4vars) {
+ rowMeans(x[, c("Tmax_C", "Tmin_C"), drop = FALSE])
+ } else {
+ NA
+ }
+ res[["dailyC4vars"]] <- if (do_C4vars) res[["dailyC4vars"]] else NA
+ res[["Cheatgrass_ClimVars"]] <- if (do_Cheatgrass_ClimVars)
+ res[["Cheatgrass_ClimVars"]] else NA
+
+ res
}
diff --git a/R/sw_OutputDerived_Functions.R b/R/sw_OutputDerived_Functions.R
index 5de95aac..282b0646 100644
--- a/R/sw_OutputDerived_Functions.R
+++ b/R/sw_OutputDerived_Functions.R
@@ -3,22 +3,71 @@
#'
#' @param x An object of class \code{\linkS4class{swOutput}}.
#' @param timestep A character string. One of the \pkg{rSOILWAT2} time steps.
+#' @param keep_time A logical value. Include time information in the returned
+#' object.
#'
#' @name get_derived_output
NULL
+
+#' Output column indices with time information
+#'
+#' @inheritParams get_derived_output
+#'
+#' @examples
+#' time_columns("Month")
+#'
+#' @export
+time_columns <- function(timestep = c("Day", "Week", "Month", "Year")) {
+ switch(
+ EXPR = match.arg(timestep),
+ Year = 1L,
+ Month = ,
+ Week = ,
+ Day = 1L:2L
+ )
+}
+
+#' Number of time steps in output
+#'
+#' @inheritParams get_derived_output
+#'
+#' @examples
+#' nrow_output(sw_exec(rSOILWAT2::sw_exampleData), "Month")
+#'
+#' @export
+nrow_output <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
+ slot(
+ x,
+ switch(
+ EXPR = match.arg(timestep),
+ Day = "dy_nrow",
+ Week = "wk_nrow",
+ Month = "mo_nrow",
+ Year = "yr_nrow"
+ )
+ )
+}
+
+
#' Calculate transpiration from output
#'
#' @inheritParams get_derived_output
#'
-#' @return A numeric vector of transpiration [mm] for each time step.
+#' @return A numeric vector of transpiration [mm] for each time step or
+#' a numeric matrix if `keep_time`.
#'
#' @examples
#' sw_out <- sw_exec(inputData = rSOILWAT2::sw_exampleData)
#' get_transpiration(sw_out, "Month")
+#' get_transpiration(sw_out, "Month", keep_time = TRUE)
#'
#' @export
-get_transpiration <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
+get_transpiration <- function(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ keep_time = FALSE
+) {
timestep <- match.arg(timestep)
res <- NULL
@@ -29,6 +78,10 @@ get_transpiration <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
# "tran_cm" output was added with SOILWAT2 v6.2.0 and rSOILWAT2 v5.0.0
res <- tmp[, "tran_cm"]
+ if (keep_time) {
+ res_time <- tmp[, time_columns(timestep), drop = FALSE]
+ }
+
} else {
tmp <- slot(slot(x, "TRANSP"), timestep)
ids <- grep("transp_total_Lyr", colnames(tmp), fixed = TRUE)
@@ -36,6 +89,10 @@ get_transpiration <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
if (all(dim(tmp) > 0) && length(ids) > 0) {
res <- apply(tmp[, ids, drop = FALSE], MARGIN = 1, FUN = sum)
+ if (keep_time) {
+ res_time <- tmp[, time_columns(timestep), drop = FALSE]
+ }
+
} else {
stop(
"Simulation run without producing transpiration output: ",
@@ -44,22 +101,35 @@ get_transpiration <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
}
}
- # convert [cm] to [mm]
- 10 * res
+ if (keep_time) {
+ cbind(
+ res_time,
+ T_mm = 10. * res
+ )
+ } else {
+ # convert [cm] to [mm]
+ 10. * res
+ }
}
+
#' Calculate evaporation from output
#'
#' @inheritParams get_derived_output
#'
-#' @return A numeric vector of evaporation [mm] for each time step.
+#' @return A numeric vector of evaporation [mm] for each time step or
+#' a numeric matrix if `keep_time`.
#'
#' @examples
#' sw_out <- sw_exec(inputData = rSOILWAT2::sw_exampleData)
#' get_evaporation(sw_out, "Month")
#'
#' @export
-get_evaporation <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
+get_evaporation <- function(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ keep_time = FALSE
+) {
timestep <- match.arg(timestep)
res <- NULL
@@ -72,6 +142,10 @@ get_evaporation <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
# "tran_cm" output was added with SOILWAT2 v6.2.0 and rSOILWAT2 v5.0.0
res <- tmp[, "evapotr_cm"] - tmp[, "tran_cm"]
+ if (keep_time) {
+ res_time <- tmp[, time_columns(timestep), drop = FALSE]
+ }
+
} else {
tmp1 <- slot(slot(x, "EVAPSURFACE"), timestep)
tmp2 <- slot(slot(x, "EVAPSOIL"), timestep)
@@ -96,6 +170,10 @@ get_evaporation <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
# evaporation from snow (sublimation)
tmp3[, "snowloss"]
+ if (keep_time) {
+ res_time <- tmp1[, time_columns(timestep), drop = FALSE]
+ }
+
} else {
stop(
"Simulation run without producing evaporation output: ",
@@ -105,8 +183,15 @@ get_evaporation <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
}
}
- # convert [cm] to [mm]
- 10 * res
+ if (keep_time) {
+ cbind(
+ res_time,
+ E_mm = 10. * res
+ )
+ } else {
+ # convert [cm] to [mm]
+ 10. * res
+ }
}
@@ -157,11 +242,14 @@ get_soiltemp <- function(
levels = c("min", "avg", "max"),
surface = TRUE,
soillayers = NULL,
+ keep_time = FALSE,
verbose = FALSE
) {
timestep <- match.arg(timestep)
levels <- match.arg(levels, several.ok = TRUE)
+ res_time <- NULL
+
#--- Deal with`soillayers`: NA, NULL, or integer vector
if (!isTRUE(is.na(soillayers)) && !is.null(soillayers)) {
soillayers <- sort(unique(as.integer(soillayers)))
@@ -192,6 +280,10 @@ get_soiltemp <- function(
)
}
+ if (keep_time) {
+ res_time <- tmp_sf[, time_columns(timestep), drop = FALSE]
+ }
+
cns_sf <- if (is_ge_v5.3.0) {
# rSOILWAT2 since v5.3.0: `surfaceTemp_min/avg/max_C`
grep("surfaceTemp_[[:alpha:]]{3}_C", colnames(tmp_sf), value = TRUE)
@@ -217,6 +309,10 @@ get_soiltemp <- function(
)
}
+ if (keep_time && is.null(res_time)) {
+ res_time <- tmp_sl[, time_columns(timestep), drop = FALSE]
+ }
+
# rSOILWAT2 before v5.3.0: `Lyr_1`, ...
# rSOILWAT2 since v5.3.0: `Lyr_1_max_C`, `Lyr_1_min_C`, `Lyr_1_avg_C`, ...
if (is.null(soillayers)) {
@@ -301,10 +397,224 @@ get_soiltemp <- function(
}
}
- cbind(res_sf, res_sl)
+ cbind(if (keep_time) res_time, res_sf, res_sl)
}
)
names(res) <- levels
res
}
+
+
+
+#' Extract or calculate soil moisture
+#'
+#' @inheritParams get_derived_output
+#' @param type A character string selecting type of soil moisture.
+#' @param swInput An object of class [swInputData-class].
+#' @param widths_cm A numeric vector of soil layer widths (units `[cm]`).
+#' @param fcoarse A numeric vector of coarse fragments per soil layer
+#' (units `[volume fraction]`).
+#'
+#' @section Details:
+#' Information on soil layer `widths` and coarse fragments `fcoarse`
+#' are only used if requested type of soil moisture is
+#' not available and has to be calculated from a different type.
+#' `widths` and `fcoarse` may be provided directly or via `swInput`
+#' from which the information is extracted (see examples).
+#'
+#' @return A data frame with requested soil moisture;
+#' rows represent time steps and columns represent soil layers.
+#'
+#' @examples
+#' sw_in <- rSOILWAT2::sw_exampleData
+#'
+#' sw_out <- sw_exec(inputData = sw_in)
+#' res1 <- get_soilmoisture(sw_out, "Month", type = "swc")
+#'
+#' deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()[["sw_swcbulk"]]
+#' sw_out <- sw_exec(inputData = sw_in)
+#' res2 <- get_soilmoisture(sw_out, "Month", type = "swc", swInput = sw_in)
+#' all.equal(res1, res2)
+#'
+#' res3 <- get_soilmoisture(
+#' sw_out,
+#' timestep = "Month",
+#' type = "swc",
+#' widths = diff(c(0., swSoils_Layers(sw_in)[, "depth_cm"])),
+#' fcoarse = swSoils_Layers(sw_in)[, "gravel_content"]
+#' )
+#' all.equal(res1, res3)
+#'
+#' @md
+#' @export
+get_soilmoisture <- function(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ type = c("swc", "vwc_bulk", "vwc_matric"),
+ swInput = NULL,
+ widths_cm = NULL,
+ fcoarse = NULL,
+ keep_time = FALSE
+) {
+ timestep <- match.arg(timestep)
+ type <- match.arg(type)
+
+ out_flag <- switch(
+ EXPR = type,
+ swc = sw_out_flags()[["sw_swcbulk"]],
+ vwc_bulk = sw_out_flags()[["sw_vwcbulk"]],
+ vwc_matric = sw_out_flags()[["sw_vwcmatric"]]
+ )
+
+
+ res <- NULL
+ msg <- NULL
+
+ tmp <- slot(slot(x, out_flag), timestep)
+ icols <- -time_columns(timestep)
+
+
+ if (nrow(tmp) > 0) {
+ res <- tmp[, icols, drop = FALSE]
+
+ if (keep_time) {
+ res_time <- tmp[, time_columns(timestep), drop = FALSE]
+ }
+
+ } else {
+ #--- Requested soil moisture output not stored in simulation output `x`
+
+ # Check if any of the other soil moisture types are available
+ tmp_swc <- slot(slot(x, sw_out_flags()[["sw_swcbulk"]]), timestep)
+ tmp_vwcbulk <- slot(slot(x, sw_out_flags()[["sw_vwcbulk"]]), timestep)
+ tmp_vwcmatric <- slot(slot(x, sw_out_flags()[["sw_vwcmatric"]]), timestep)
+
+ has_swc <- nrow(tmp_swc) > 0L
+ has_vwcbulk <- nrow(tmp_vwcbulk) > 0L
+ has_vwcmatric <- nrow(tmp_vwcmatric) > 0L
+
+ if (any(has_swc, has_vwcbulk, has_vwcmatric)) {
+ # Determine whether we have enough soil information for calculations
+ has_soil <-
+ inherits(swInput, "swInputData") ||
+ !any(is.null(widths_cm), is.null(fcoarse))
+
+ if (has_soil) {
+ if (is.null(widths_cm)) {
+ widths_cm <- diff(c(0., swSoils_Layers(swInput)[, "depth_cm"]))
+ }
+
+ one_minus_fcoarse <- 1. - if (is.null(fcoarse)) {
+ swSoils_Layers(swInput)[, "gravel_content"]
+ } else {
+ fcoarse
+ }
+
+ if (type == "swc") {
+ if (has_vwcbulk) {
+ # calculate swc as depth * vwc_bulk
+ res <- sweep(
+ tmp_vwcbulk[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = widths_cm,
+ FUN = "*"
+ )
+ if (keep_time) {
+ res_time <- tmp_vwcbulk[, time_columns(timestep), drop = FALSE]
+ }
+
+ } else if (has_vwcmatric) {
+ # calculate swc as depth * vwc_matric * (1 - fcoarse)
+ res <- sweep(
+ tmp_vwcmatric[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = widths_cm * one_minus_fcoarse,
+ FUN = "*"
+ )
+ if (keep_time) {
+ res_time <- tmp_vwcmatric[, time_columns(timestep), drop = FALSE]
+ }
+ }
+
+ } else if (type == "vwc_bulk") {
+ if (has_swc) {
+ # calculate vwc_bulk as swc / depth
+ res <- sweep(
+ tmp_swc[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = widths_cm,
+ FUN = "/"
+ )
+ if (keep_time) {
+ res_time <- tmp_swc[, time_columns(timestep), drop = FALSE]
+ }
+
+ } else if (has_vwcmatric) {
+ # calculate vwc_bulk as vwc_matric * (1 - fcoarse)
+ res <- sweep(
+ tmp_vwcmatric[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = one_minus_fcoarse,
+ FUN = "*"
+ )
+ if (keep_time) {
+ res_time <- tmp_vwcmatric[, time_columns(timestep), drop = FALSE]
+ }
+ }
+
+ } else if (type == "vwc_matric") {
+ if (has_swc) {
+ # calculate vwc_matric as swc / (depth * (1 - fcoarse))
+ res <- sweep(
+ tmp_swc[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = widths_cm * one_minus_fcoarse,
+ FUN = "/"
+ )
+ if (keep_time) {
+ res_time <- tmp_swc[, time_columns(timestep), drop = FALSE]
+ }
+
+ } else if (has_vwcbulk) {
+ # calculate vwc_matric as vwc_bulk / (1 - fcoarse)
+ res <- sweep(
+ tmp_vwcbulk[, icols, drop = FALSE],
+ MARGIN = 2L,
+ STATS = one_minus_fcoarse,
+ FUN = "/"
+ )
+ if (keep_time) {
+ res_time <- tmp_vwcbulk[, time_columns(timestep), drop = FALSE]
+ }
+ }
+ }
+
+ } else {
+ msg <- paste(
+ "Simulation run without requested soil moisture output:",
+ "converting available to requested output requires",
+ "`swInput` or, alternatively, `widths_cm` and `fcoarse`."
+ )
+ }
+
+
+ } else {
+ msg <- paste(
+ "Simulation run without producing soil moisture output:",
+ "consider turning output on for at least one of",
+ "'SWCBULK', 'VWCBULK', or 'VWCMATRIC'."
+ )
+ }
+ }
+
+ if (!is.null(msg)) {
+ stop(msg)
+ }
+
+ if (keep_time) {
+ cbind(res_time, res)
+ } else {
+ res
+ }
+}
diff --git a/R/sw_Pedotransfer_Functions.R b/R/sw_Pedotransfer_Functions.R
index 2c7fdd6a..005939d3 100644
--- a/R/sw_Pedotransfer_Functions.R
+++ b/R/sw_Pedotransfer_Functions.R
@@ -1,17 +1,30 @@
-#' Pedotransfer functions to convert between soil moisture (volumetric water
-#' content, \var{VWC}) and soil water potential (\var{SWP})
+
+#------ Deprecated functions ------
+#' Deprecated pedotransfer functions to convert between soil moisture
+#' (volumetric water content, \var{VWC}) and soil water potential (\var{SWP})
#'
#' @param sand A numeric value or vector. Sand content of the soil layer(s) as
#' fractional value in \code{[0,1]}.
#' @param clay A numeric value or vector. Clay content of the soil layer(s) as
#' fractional value in \code{[0,1]}.
+#' @param thetas Soon obsolete ... (see `feature_swrc`)
+#' @param psis Soon obsolete ... (see `feature_swrc`)
+#' @param b Soon obsolete ... (see `feature_swrc`)
+#' @param MPa_toBar Soon obsolete ... (see `feature_swrc`)
+#' @param bar_conversion Soon obsolete ... (see `feature_swrc`)
+#' @param bar_toMPa Soon obsolete ... (see `feature_swrc`)
+#' @param ... Additional arguments.
#'
#' @references Cosby, B. J., G. M. Hornberger, R. B. Clapp, and T. R. Ginn.
#' 1984. A statistical exploration of the relationships of soil moisture
#' characteristics to the physical properties of soils. Water Resources Research
#' 20:682-690.
#'
+#' @seealso The use of these functions is deprecated;
+#' please use `ptf_estimate()` and `swrc_conversion()` instead.
+#'
#' @name pedotransfer
+#' @md
NULL
#' @rdname pedotransfer
@@ -126,7 +139,18 @@ pedotransfer <- function(x, sand, clay, pdf) {
#' vectors are repeated for each row}
#' }
#' @export
-SWPtoVWC <- function(swp, sand, clay) {
+SWPtoVWC <- function(swp, sand, clay, ...) {
+ .Deprecated("swrc_swp_to_vwc")
+
+ swrc_swp_to_vwc(
+ swp_MPa = swp,
+ sand = sand,
+ clay = clay,
+ ...
+ )
+}
+
+SWPtoVWC_old <- function(swp, sand, clay) {
pedotransfer(swp, sand, clay, pdf = pdf_to_vwc)
}
@@ -167,6 +191,1494 @@ SWPtoVWC <- function(swp, sand, clay) {
#' vectors are repeated for each row}
#' }
#' @export
-VWCtoSWP <- function(vwc, sand, clay) {
+VWCtoSWP <- function(vwc, sand, clay, ...) {
+ .Deprecated("swrc_vwc_to_swp")
+
+ swrc_vwc_to_swp(
+ vwcBulk = vwc,
+ sand = sand,
+ clay = clay,
+ ...
+ )
+}
+
+VWCtoSWP_old <- function(vwc, sand, clay) {
pedotransfer(vwc, sand, clay, pdf = pdf_to_swp)
}
+
+
+
+
+#------ SWRC parameters & pedotransfer functions ------
+
+# MAINTENANCE:
+# Notes for implementing a new PTF "YYY" in `rSOILWAT2`
+# * new `ptf_YYY_for_XXX()`
+# * new `ptf_YYY_availability(verbose = interactive(), ...)`
+# * update `ptfs_implemented_by_rSW2()`
+# * update `rSW2_check_SWRC_vs_PTF()`
+# * update `rSW2_SWRC_PTF_estimate_parameters()`
+# * update `check_ptf_availability()`
+# * update examples and unit tests to utilize new functions
+#
+# Notes for implementing a new SWRC "XXX" and/or PTF "YYY" in `SOILWAT2`
+# 1) SOILWAT2: see notes in SOILWAT2/src/SW_Site.h
+# 2) rSOILWAT2: everything should automatically work with new XXX/YYY
+# * update examples and unit tests to utilize new functions
+
+
+#' Functionality for Soil Water Retention Curves (`SWRC`)
+#'
+#' @description
+#' `SWRCs` convert between soil water content and soil water potential
+#' using a set of parameters, see [swrc_swp_to_vwc()] and [swrc_vwc_to_swp()].
+#'
+#' The `SWRC` parameters may be estimated from soil properties with suitable
+#' pedotransfer functions `PTFs`, see [ptf_estimate()].
+#'
+#' The `SWRC` parameters can be checked for consistency with [check_swrcp()].
+#'
+#'
+#' @param sand A numeric value or vector.
+#' Sand content of the matric soil component
+#' (< 2 mm fraction; units of `[g/g]`) of each soil layer.
+#' @param clay A numeric value or vector.
+#' Clay content of the matric soil component
+#' (< 2 mm fraction; units of `[g/g]`) of each soil layer.
+#' @param fcoarse A numeric value or vector.
+#' Coarse fragments, e.g., gravel, (> 2 mm; units of `[m3/m3]`)
+#' relative to the whole soil of each soil layer.
+#' `fcoarse` is required, for instance, to translate between
+#' values relative to the matric soil component (< 2 mm fraction) and
+#' relative to the whole soil (matric soil plus coarse fragments).
+#' @param bdensity A numeric value or vector.
+#' Density of the whole soil
+#' (matric soil plus coarse fragments; units `[g/cm3]`).
+#' @param layer_width A numeric value or vector.
+#' Depth interval, width, of each soil layer (units of `cm`).
+#' `layer_width` is required to translate between
+#' soil water content of a soil layer and volumetric water content.
+#' @param swrc_name An character string or vector.
+#' The selected `SWRC` name
+#' (one of [swrc_names()], with default `"Campbell1974"`).
+#' @param ptf_name An character string or vector.
+#' The selected `PTF` name
+#' (one of [ptf_names()], with default `"Cosby1984AndOthers"`).
+#' @param swrcp A numeric vector or matrix.
+#' The parameters of a selected `SWRC`;
+#' each row represents one `SWRC`, e.g., one per soil layer.
+#' @param swrc A named list.
+#' Contains all necessary elements of a `SWRC`,
+#' i.e., `name` (short for `swrc_name`) and `swrcp`,
+#' or all necessary elements to estimate parameters of a `SWRC` given
+#' soil parameters, i.e., `swrc_name` and `ptf_name`.
+#' @param fail A logical value.
+#' Issue a warning (`FALSE`, default) or throw an error (`TRUE`)
+#' if request fails.
+#' @param verbose A logical value. If `TRUE`, then display
+#' `SOILWAT2` internal warnings and other messages.
+#' @param ... Additional function arguments passed on or ignored.
+#'
+#' @section Details:
+#' [swrc_names()] lists implemented `SWRCs`;
+#' [ptf_names()] lists implemented `PTFs`.
+#'
+#' @inherit ptf_Rosetta_for_vanGenuchten1980 references
+#' @inherit ptf_neuroFX2021_for_FXW references
+#' @references
+#' Cosby, B. J., G. M. Hornberger, R. B. Clapp, & T. R. Ginn. 1984.
+#' A statistical exploration of the relationships of soil moisture
+#' characteristics to the physical properties of soils.
+#' Water Resources Research, 20:682-690, \doi{10.1029/WR020i006p00682}
+#'
+#' @seealso
+#' [swrc_names()],
+#' [ptf_names()],
+#' [check_ptf_availability()],
+#' [ptf_estimate()],
+#' [check_swrcp()],
+#' [swrc_swp_to_vwc()],
+#' [swrc_vwc_to_swp()]
+#'
+#' @name SWRCs
+#' @md
+NULL
+
+
+#' List Soil Water Retention Curves `SWRCs`
+#'
+#' @return An integer vector with names of implemented `SWRCs`
+#'
+#' @details Notes:
+#' The integer values may change with new versions of `SOILWAT2.`
+#'
+#' @seealso [`SWRCs`], [ptf_names()], [check_ptf_availability()]
+#'
+#' @md
+#' @export
+swrc_names <- function() {
+ rSW2_glovars[["kSOILWAT2"]][["SWRC_types"]]
+}
+
+#' List Pedotransfer Functions `PTFs`
+#'
+#' @return An named integer vector with names of implemented `PTFs`
+#'
+#' @details Notes:
+#' The integer values may change with new versions of `SOILWAT2.`
+#'
+#' @seealso [`SWRCs`], [swrc_names()], [check_ptf_availability()]
+#'
+#' @md
+#' @export
+ptf_names <- function() {
+ tmp1 <- ptfs_implemented_by_SW2(names_only = FALSE)
+ tmp2 <- ptfs_implemented_by_rSW2()
+
+ c(
+ tmp1,
+ stats::setNames(max(tmp1) + seq_along(tmp2), tmp2)
+ )
+}
+
+
+
+#' List `PTFs` implemented by `rSOILWAT2`
+#' @md
+ptfs_implemented_by_rSW2 <- function() {
+ c(
+ # `Rosetta3` estimates parameters of `vanGenuchten1980` SWRC
+ "Rosetta3",
+ # `neuroFX2021` estimates parameters of `FXW` SWRC
+ "neuroFX2021"
+ )
+}
+
+#' List `PTFs` implemented by `SOILWAT2`
+#'
+#' @param names_only A logical value, see `return` value.
+#'
+#' @return An named integer vector (if not `names_only`)
+#' with or a character vector (if `names_only`) names of implemented `PTFs`.
+#'
+#' @md
+ptfs_implemented_by_SW2 <- function(names_only = FALSE) {
+ res <- rSW2_glovars[["kSOILWAT2"]][["PTF_types"]]
+
+ if (isTRUE(names_only)) names(res) else res
+}
+
+
+#' Standardize a `SWRC` name
+#'
+#' `"Campbell1974"` is the backwards compatible default.
+#'
+#' @md
+#' @noRd
+std_swrc <- function(swrc_name) {
+ if (missing(swrc_name) || is.null(swrc_name) || all(is.na(swrc_name))) {
+ "Campbell1974"
+ } else {
+ as.character(swrc_name)
+ }
+}
+
+#' Standardize a `PTF` name
+#'
+#' `"Cosby1984AndOthers"` is the backwards compatible default.
+#'
+#' @md
+#' @noRd
+std_ptf <- function(ptf_name) {
+ if (missing(ptf_name) || is.null(ptf_name) || all(is.na(ptf_name))) {
+ "Cosby1984AndOthers"
+ } else {
+ as.character(ptf_name)
+ }
+}
+
+
+#' Translate a `SWRC` name to its `SOILWAT2` internal integer code
+#'
+#' @return An integer value. `NA` if `swrc_name` is not implemented.
+#'
+#' @md
+#' @noRd
+encode_name2swrc <- function(swrc_name, fail = TRUE) {
+ res <- as.integer(unname(swrc_names()[std_swrc(swrc_name)]))
+
+ if (isTRUE(fail) && anyNA(res)) {
+ stop(
+ "Requested SWRC ",
+ shQuote(swrc_name[is.na(res)]),
+ " is not available."
+ )
+ }
+
+ res
+}
+
+#' Translate a `PTF` name to its `SOILWAT2` internal integer code
+#'
+#' @return An integer value. `NA` if `ptf_name` is not implemented.
+#'
+#' @md
+#' @noRd
+encode_name2ptf <- function(ptf_name, fail = TRUE) {
+ res <- as.integer(unname(ptfs_implemented_by_SW2()[std_ptf(ptf_name)]))
+
+ if (isTRUE(fail) && anyNA(res)) {
+ stop("Requested PTF ", shQuote(ptf_name[is.na(res)]), " is not available.")
+ }
+
+ res
+}
+
+
+#' Matching pairs of implemented `SWRCs` and `PTFs`
+#'
+#' @inheritParams SWRCs
+#'
+#' @return A `data.frame` with two columns `SWRC` and `PTF` where each
+#' row contains a matching pair of `SWRC` and `PTF` that are implemented.
+#'
+#' @examples
+#' # Data frame of SWRC-PTF combinations
+#' df_swrc_ptfs <- rSOILWAT2::list_matched_swrcs_ptfs()
+#'
+#' # List of SWRC-PTF combinations
+#' list_swrcs_ptfs <- unname(as.list(as.data.frame(t(df_swrc_ptfs))))
+#'
+#' # Available SWRC-PTF combinations
+#' has_ptf <- check_ptf_availability(df_swrc_ptfs[, "PTF"])
+#' df_swrc_ptfs[has_ptf, , drop = FALSE]
+#' list_swrcs_ptfs[has_ptf]
+#'
+#' @md
+#' @export
+list_matched_swrcs_ptfs <- function(swrc_name = names(swrc_names())) {
+ res <- expand.grid(
+ SWRC = std_swrc(swrc_name),
+ PTF = names(ptf_names()),
+ stringsAsFactors = FALSE,
+ KEEP.OUT.ATTRS = FALSE
+ )
+
+ ids <- check_SWRC_vs_PTF(res[, "SWRC"], res[, "PTF"])
+
+ res <- res[ids, , drop = FALSE]
+ rownames(res) <- NULL
+ res
+}
+
+
+#' Check whether `PTF` and `SWRC` are compatible and implemented
+#'
+#' @inheritParams SWRCs
+#'
+#' @return A logical vector.
+#'
+#' @examples
+#' check_SWRC_vs_PTF("Campbell1974", c("Cosby1984", "Rosetta3"))
+#'
+#' @md
+#' @export
+check_SWRC_vs_PTF <- function(swrc_name, ptf_name, fail = FALSE) {
+ swrc_names <- std_swrc(swrc_name)
+ ptf_names <- std_ptf(ptf_name)
+
+ n_swrcs <- length(swrc_names)
+ n_ptfs <- length(ptf_names)
+
+ if (n_swrcs == 1L && n_ptfs > 1L) {
+ swrc_names <- rep(swrc_names, n_ptfs)
+ n_swrcs <- n_ptfs
+ } else if (n_swrcs > 1L && n_ptfs == 1L) {
+ ptf_names <- rep(ptf_names, n_swrcs)
+ n_ptfs <- n_swrcs
+ }
+
+ stopifnot(n_swrcs == n_ptfs)
+
+ # Check if SWRC/PTF implemented in rSOILWAT2
+ has_rSW2 <- rSW2_check_SWRC_vs_PTF(swrc_names, ptf_names)
+
+ # Check if SWRC/PTF implemented in SOILWAT2
+ has_SW2 <- mapply(
+ function(s, p) .Call(C_sw_check_SWRC_vs_PTF, s, p),
+ swrc_names,
+ ptf_names
+ )
+
+ # SWRC/PTF implemented in either rSOILWAT2 or SOILWAT2
+ res <- unname(has_rSW2 | has_SW2)
+
+
+ if (!all(res) && isTRUE(fail)) {
+ ids <- which(!res)
+
+ stop(
+ toString(paste(swrc_names[ids], ptf_names[ids], collapse = "-")),
+ " are not available or incompatible."
+ )
+ }
+
+ res
+}
+
+#' Check whether `PTF` and `SWRC` are compatible and implemented in `rSOILWAT2`
+#'
+#' @inheritParams SWRCs
+#'
+#' @md
+#' @noRd
+rSW2_check_SWRC_vs_PTF <- function(swrc_name, ptf_name) {
+ swrc_name <- std_swrc(swrc_name)
+ ptf_name <- std_ptf(ptf_name)
+
+ ptf_name %in% ptfs_implemented_by_rSW2() & (
+ swrc_name == "vanGenuchten1980" & ptf_name == "Rosetta3" |
+ swrc_name == "FXW" & ptf_name == "neuroFX2021"
+ )
+}
+
+
+#' Estimate `SWRC` parameters from soil texture with a pedotransfer function
+#'
+#' @inheritParams SWRCs
+#' @param ... Additional parameters passed to selected `PTF` function.
+#'
+#' @section Notes:
+#' [swrc_names()] lists implemented `SWRCs`;
+#' [ptf_names()] lists implemented `PTFs`; and
+#' [check_ptf_availability()] checks availability of `PTFs`.
+#'
+#' @section Notes:
+#' The soil parameters `sand`, `clay`, `fcoarse`, and `bdensity` must be of
+#' the same length, i.e., represent one soil (length 1) or
+#' multiple soil (layers) (length > 1); however, `bdensity` may be `NULL`.
+#' The arguments selecting `SWRC` (`swrc_name`) and `PTF` (`ptf_name`)
+#' are recycled for multiple soil layers.
+#'
+#' @inherit SWRCs references
+#'
+#' @return `swrcp`, i.e,.
+#' a numeric matrix where rows represent soil (layers) and
+#' columns represent a fixed number of `SWRC` parameters.
+#' The interpretation is dependent on the selected `SWRC`, see
+#' `SOILWAT2` input file `swrc_param.in`
+# nolint start: line_length_linter.
+#' (
+#' `system.file("extdata", "example1", "Input", "swrc_params.in", package = "rSOILWAT2")`
+#' ).
+# nolint end
+#'
+#' @examples
+#' ptf_estimate(sand = c(0.5, 0.3), clay = c(0.2, 0.1), fcoarse = c(0, 0))
+#'
+#' soils <- swSoils_Layers(rSOILWAT2::sw_exampleData)
+#'
+#' # Use PTF "Cosby1984" to estimate parameters of SWRC "Campbell1974"
+#' ptf_estimate(
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' fcoarse = soils[, "gravel_content"],
+#' swrc_name = "Campbell1974",
+#' ptf_name = "Cosby1984"
+#' )
+#'
+#' # Use PTF "Rosetta3" to estimate parameters of SWRC "vanGenuchten1980"
+#' if (check_ptf_availability("Rosetta3")) {
+#' ptf_estimate(
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' fcoarse = soils[, "gravel_content"],
+#' bdensity = soils[, "bulkDensity_g/cm^3"],
+#' swrc_name = "vanGenuchten1980",
+#' ptf_name = "Rosetta3"
+#' )
+#' }
+#'
+#' # Use PTF "neuroFX2021" to estimate parameters of SWRC `FXW`
+#' \dontrun{
+#' # Set neuroFX2021 file path, see details in `ptf_neuroFX2021_for_FXW()`
+#' options(RSW2_FILENEUROFX2021 = "path/to/sscbd.RData")
+#' }
+#'
+#' if (check_ptf_availability("neuroFX2021")) {
+#' ptf_estimate(
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' fcoarse = soils[, "gravel_content"],
+#' bdensity = soils[, "bulkDensity_g/cm^3"],
+#' swrc_name = "FXW",
+#' ptf_name = "neuroFX2021"
+#' )
+#' }
+#'
+#' @md
+#' @export
+ptf_estimate <- function(
+ sand,
+ clay,
+ fcoarse,
+ bdensity = NULL,
+ swrc_name,
+ ptf_name,
+ fail = FALSE,
+ ...
+) {
+
+ #--- Check for consistency between SWRC and PTF
+ swrc_name <- std_swrc(swrc_name)[1]
+ ptf_name <- std_ptf(ptf_name)[1]
+
+ check_SWRC_vs_PTF(swrc_name, ptf_name, fail = TRUE)
+
+
+ #--- Determine whether we use a C- or R-implemented PTF
+ swrcp <- if (ptf_name %in% ptfs_implemented_by_rSW2()) {
+ rSW2_SWRC_PTF_estimate_parameters(
+ ptf_name = ptf_name,
+ sand = sand,
+ clay = clay,
+ fcoarse = fcoarse,
+ bdensity = bdensity,
+ fail = fail,
+ ...
+ )
+
+ } else {
+ .Call(
+ C_rSW2_SWRC_PTF_estimate_parameters,
+ ptf_type = rep_len(encode_name2ptf(ptf_name), length(sand)),
+ sand = sand,
+ clay = clay,
+ fcoarse = fcoarse,
+ bdensity = bdensity
+ )
+ }
+
+
+ #--- Check validity of estimated SWRCp
+ if (!all(check_swrcp(swrc_name, swrcp))) {
+ msg <- "Some estimated parameters failed checks."
+
+ if (isTRUE(fail)) stop(msg) else warning(msg)
+ }
+
+ swrcp
+}
+
+
+#' Check availability of `PTFs`
+#'
+#' `PTFs` implemented in `SOILWAT2` are always available;
+#' `PTFs` implemented in `rSOILWAT2` may have additional requirements, e.g.,
+#' live internet connection or access to specific data files.
+#'
+#' @param ptfs A character vector. `PTF` names to be checked;
+#' defaults to [ptf_names()].
+#' @param verbose A logical value.
+#'
+#' @return A named logical vector with current availability of `PTFs`;
+#' `PTFs` that are not implemented return `NA`.
+#'
+#' @examples
+#' check_ptf_availability()
+#' check_ptf_availability("neuroFX2021")
+#' check_ptf_availability("nonexistent_PTF")
+#'
+#' @export
+#' @md
+check_ptf_availability <- function(
+ ptfs = names(ptf_names()),
+ verbose = interactive()
+) {
+ res <- rep(NA, length(ptfs))
+ names(res) <- ptfs
+
+ rptfs <- ptfs_implemented_by_rSW2()
+ is_rptf <- ptfs %in% rptfs
+
+ # PTFs implemented in SOILWAT2 are always available
+ tmp <- ptfs %in% ptfs_implemented_by_SW2(names_only = TRUE) & !is_rptf
+ res[tmp] <- TRUE
+
+ # Check requested PTFs implemented in R
+ has_rptfs <- vapply(
+ ptfs[is_rptf],
+ function(ptf) {
+ switch(
+ EXPR = ptf,
+ Rosetta3 = ptf_Rosetta3_availability(verbose = verbose),
+ neuroFX2021 = ptf_neuroFX2021_availability(verbose = verbose),
+ NA
+ )
+ },
+ FUN.VALUE = NA,
+ USE.NAMES = TRUE
+ )
+
+ res[names(has_rptfs)] <- has_rptfs
+
+ res
+}
+
+
+#' Estimate parameters of selected soil water retention curve (`SWRC`)
+#' using selected pedotransfer function (`PTF`) that are implemented in `R`
+#'
+#' @inheritParams ptf_estimate
+#' @param fail A logical value. If requested `PTF` fails,
+#' then issue a warning (`FALSE`) or throw an error (`TRUE`, default).
+#'
+#' @return `swrcp`, i.e,.
+#' a numeric matrix where rows represent soil (layers) and
+#' columns represent a fixed number of `SWRC` parameters.
+#' The interpretation is dependent on the selected `SWRC`.
+#' However, return value is `NULL`
+#' only if `fail` is `FALSE` and requested `PTF` is not implemented in `R`.
+#'
+#' @inherit SWRCs references
+#'
+#' @section Details:
+#' [ptf_estimate()] is the function that should be directly called; this here
+#' is an internal helper function.
+#'
+#' @section Notes:
+#' See `SWRC_PTF_estimate_parameters()` in `SOILWAT2` for `PTFs`
+#' implemented in C.
+#'
+#' @md
+rSW2_SWRC_PTF_estimate_parameters <- function( # nolint: object_length_linter.
+ ptf_name,
+ sand,
+ clay,
+ fcoarse,
+ bdensity = NULL,
+ fail = TRUE,
+ ...
+) {
+ ptf_name <- std_ptf(ptf_name)[1]
+ has_ptf <- ptf_name %in% ptfs_implemented_by_rSW2()
+
+ list_soilargs <- list(
+ sand = sand,
+ clay = clay,
+ bdensity = bdensity
+ )
+
+ if (has_ptf && ptf_name %in% "Rosetta3") {
+ dots <- list(...)
+ dots[["version"]] <- if ("version" %in% names(dots)) {
+ as.character(dots[["version"]])
+ } else {
+ "3"
+ }
+
+ do.call(
+ ptf_Rosetta_for_vanGenuchten1980,
+ args = c(list_soilargs, dots)
+ )
+
+ } else if (has_ptf && ptf_name %in% "neuroFX2021") {
+ do.call(
+ ptf_neuroFX2021_for_FXW,
+ args = c(list_soilargs, list(...))
+ )[["mean"]]
+
+ } else {
+ msg <- paste("PTF", shQuote(ptf_name), "is not implemented in rSOILWAT2.")
+
+ if (isTRUE(fail)) stop(msg) else warning(msg)
+
+ NULL
+ }
+}
+
+
+#' Estimate van Genuchten 1980 `SWRC` parameters using `Rosetta` live `API`
+#'
+#' @inheritParams SWRCs
+#' @param version A character string that selects a `Rosetta` version.
+#'
+#' @return `swrcp`, i.e,.
+#' a numeric matrix where rows represent soil (layers) and
+#' columns represent a fixed number of `SWRC` parameters: \itemize{
+#' \item `swrcp[0]` (`theta_r`): residual volumetric water content
+#' of the matric component (units of `[cm / cm]`)
+#' \item `swrcp[1]` (`theta_s`): saturated volumetric water content
+#' of the matric component (units of `[cm / cm]`)
+#' \item `swrcp[2]` (`alpha`): related to the inverse of
+#' air entry suction (units of `[cm-1]`)
+#' \item `swrcp[3]` (`n`): measure of the pore-size distribution `[-]`
+#' \item `swrcp[4]` (`K_sat`): saturated hydraulic conductivity `[cm / day]`
+#' }
+#'
+#' @references
+#' Mualem, Y. 1976. A new model for predicting the hydraulic conductivity of
+#' unsaturated porous media.
+#' Water Resources Research, 12:513-522, \doi{10.1029/WR012i003p00513}
+#' @references
+#' van Genuchten, M. T. 1980. A Closed-form Equation for Predicting the
+#' Hydraulic Conductivity of Unsaturated Soils.
+#' Soil Science Society of America Journal, 44:892-898,
+#' \doi{10.2136/sssaj1980.03615995004400050002x}
+#' @references
+#' Zhang, Y., & Schaap, M. G. 2017. Weighted recalibration of the
+#' Rosetta pedotransfer model with improved estimates of
+#' hydraulic parameter distributions and summary statistics (Rosetta3).
+#' Journal of Hydrology, 547:39-53, \doi{10.1016/j.jhydrol.2017.01.004}
+#'
+#' @section Details:
+#' [ptf_estimate()] is the function that should be directly called; this here
+#' is an internal helper function.
+#'
+#' @section Notes:
+#' This function calls [soilDB::ROSETTA()] and
+#' a live internet connection is required to access `Rosetta`.
+#'
+#' @seealso [soilDB::ROSETTA()]
+#'
+#' @md
+ptf_Rosetta_for_vanGenuchten1980 <- function( # nolint: object_length_linter.
+ sand,
+ clay,
+ bdensity = NULL,
+ version = c("3", "1", "2"),
+ verbose = interactive(),
+ ...
+) {
+ stopifnot(ptf_Rosetta3_availability(verbose = verbose))
+
+ version <- match.arg(version)
+
+ if (verbose) {
+ message("Connecting live to ROSETTA API...")
+ }
+
+ tmp_txt <- 100 * data.frame(
+ sand = sand,
+ silt = 1 - (sand + clay),
+ clay = clay
+ )
+ var_txt <- c("sand", "silt", "clay")
+
+ tmp <- if (is.null(bdensity)) {
+ soilDB::ROSETTA(tmp_txt, vars = var_txt, v = version)
+ } else {
+ soilDB::ROSETTA(
+ cbind(tmp_txt, bdensity = bdensity),
+ vars = c(var_txt, "bdensity"),
+ v = version
+ )
+ }
+
+ unname(data.matrix(data.frame(
+ tmp[, c("theta_r", "theta_s")],
+ 10 ^ tmp[, "alpha"],
+ 10 ^ tmp[, "npar"],
+ 10 ^ tmp[, "ksat"],
+ 0
+ )))
+}
+
+# Checks availability of `Rosetta3` `PTF`
+#
+# Note: `check_ptf_availability()` requires function name
+# to match pattern "ptf_XXX_availability" where XXX = name of PTF
+ptf_Rosetta3_availability <- function(verbose = interactive(), ...) {
+ tmp <- c(
+ requireNamespace("soilDB"),
+ requireNamespace("curl") && curl::has_internet()
+ )
+
+ res <- all(tmp)
+
+ if (!res && verbose) {
+ if (!tmp[1]) {
+ message(
+ "`ptf_Rosetta3_availability()`: ",
+ "R package 'soilDB' is not available."
+ )
+ }
+ if (!tmp[2]) {
+ message(
+ "`ptf_Rosetta3_availability()`: ",
+ "R package 'curl' is not available or there is no live internet."
+ )
+ }
+ }
+
+ res
+}
+
+
+#' Estimate `FXW` `SWRC` parameters using `neuroFX2021`
+#'
+#' @inheritParams SWRCs
+#' @param file_neuroFX2021 A character string that contains the file name with
+#' full path of the `neuroFX2021` R object provided by Rudiyanto et al. 2021;
+#' The path to the appropriate file can be set per R session
+#' via option `"RSW2_FILENEUROFX2021"`, see additional details.
+#'
+#' @return `swrcp`, i.e,.
+#' a numeric matrix where rows represent soil (layers) and
+#' columns represent a fixed number of `SWRC` parameters: \itemize{
+#' \item `swrcp[0]` (`theta_s`): saturated volumetric water content
+#' of the matric component (units of `[cm / cm]`)
+#' \item `swrcp[1]` (`alpha`): shape parameter (units of `[cm-1]`)
+#' \item `swrcp[2]` (`n`): shape parameter `[-]`
+#' \item `swrcp[3]` (`m`): shape parameter `[-]`
+#' \item `swrcp[4]` (`K_sat`): saturated hydraulic conductivity `[cm / day]`
+#' \item `swrcp[5]` (`L`): tortuosity/connectivity parameter `[-]`
+#' }
+#'
+#' @references
+#' Rudiyanto, Minasny, B., Chaney, N. W., Maggi, F., Goh Eng Giap, S.,
+#' Shah, R. M., Fiantis, D., & Setiawan, B. I. 2021.
+#' Pedotransfer functions for estimating soil hydraulic properties from
+#' saturation to dryness.
+#' Geoderma, 403:115194, \doi{10.1016/j.geoderma.2021.115194}
+#' @references
+#' Fredlund, D. G., & Xing, A. 1994.
+#' Equations for the soil-water characteristic curve.
+#' Canadian Geotechnical Journal, 31: 512–532, \doi{10.1139/t94-061}
+#' @references
+#' Wang, Y., Jin, M., & Deng, Z. 2018.
+#' Alternative model for predicting soil hydraulic conductivity over
+#' the complete moisture range.
+#' Water Resources Research, 54:6860–6876, \doi{10.1029/2018WR023037}
+#'
+#' @section Details:
+#' [ptf_estimate()] is the function that should be directly called; this here
+#' is an internal helper function.
+#'
+#' @section Details:
+#' This function requires that users download
+#' the fitted `neuroFX2021` neural networks published by Rudiyanto et al. 2021
+#' in Supplementary Material 1 (resulting in a local file named `xxx_mmc1.zip`).
+#' This needs to be unzipped and the resulting `tar` file unpacked;
+#' this produces a folder `R code for neuroFX2021`.
+#' This folder contains two R data files : `ssc.RData` and `sscbd.RData`.
+#' The argument `file_neuroFX2021` is the file name (with path) to `sscbd.RData`
+#' if soil density data are available and to `ssc.RData` otherwise
+#' (see Rudiyanto et al. 2021).
+#' The path to the appropriate file can be set per R session
+#' via option `"RSW2_FILENEUROFX2021"`
+#' (and avoid passing it directly as argument to the function);
+#' this can be useful, for example, if `ptf_estimate()` is used for `FXW`.
+#'
+#' @md
+ptf_neuroFX2021_for_FXW <- function(
+ sand,
+ clay,
+ bdensity = NULL,
+ file_neuroFX2021 = getOption("RSW2_FILENEUROFX2021", NULL),
+ ...
+) {
+ stopifnot(ptf_neuroFX2021_availability(file_neuroFX2021))
+
+ # Load `neuroFX2021`
+ nfx <- new.env()
+ load(file_neuroFX2021, envir = nfx)
+
+ # Check whether type of neuroFX2021 is
+ # SSC (sand, silt, clay) or
+ # SSCBD (sand, silt, clay, bulk density)
+ is_sscbd <- dim(nfx[["tW1"]])[2] == 4
+
+ # Prepare soil data
+ tmp_txt <- data.frame(
+ sand = sand,
+ silt = 1 - (sand + clay),
+ clay = clay
+ )
+
+ if (!is.null(bdensity)) {
+ if (is_sscbd) {
+ tmp_txt[, "bd"] <- bdensity
+ } else {
+ warning(
+ "`ptf_neuroFX2021_for_FXW()`: ",
+ "`bdensity` ignored because ",
+ "'neuroFX2021' object is for SSC (sand, silt, clay)."
+ )
+ }
+ } else {
+ if (is_sscbd) {
+ stop(
+ "`ptf_neuroFX2021_for_FXW()`: ",
+ "'neuroFX2021' object is for SSCBD (sand, silt, clay, bulk density) ",
+ "but `bdensity` contains no values."
+ )
+ }
+ }
+
+ # Evaluate neuroFX2021
+ res <- iterate_neuroFX(tmp_txt, nfx, niter = dim(nfx[["tW1"]])[1])
+
+ # Aggregate across iterations
+ tmp_res <- lapply(c("mean", "sd"), function(f) apply(res, 2:3, f))
+
+ # Backtransformation
+ for (k in seq_along(tmp_res)) {
+ # backtransform log(alpha) -> alpha
+ tmp_res[[k]][, 2] <- exp(tmp_res[[k]][, 2])
+ # backtransform log(n - 1) -> n
+ tmp_res[[k]][, 3] <- 1 + exp(tmp_res[[k]][, 3])
+ # backtransform log10(Ks) -> Ks
+ tmp_res[[k]][, 5] <- 10 ^ tmp_res[[k]][, 5]
+ }
+
+ list(
+ mean = tmp_res[[1]],
+ sd = tmp_res[[2]]
+ )
+}
+
+# Checks availability of `neuroFX2021` `PTF`
+#
+# Note: `check_ptf_availability()` requires function name
+# to match pattern "ptf_XXX_availability" where XXX = name of PTF
+ptf_neuroFX2021_availability <- function(
+ file_neuroFX2021 = getOption("RSW2_FILENEUROFX2021", NULL),
+ verbose = interactive(),
+ ...
+) {
+ res <- !is.null(file_neuroFX2021) && file.exists(file_neuroFX2021)
+
+ if (!res && verbose) {
+ message(
+ "`ptf_neuroFX2021_availability()`: ",
+ "data file 'file_neuroFX2021' does not exist; ",
+ "see documentation for `ptf_neuroFX2021_for_FXW()` and consider setting ",
+ "`options(RSW2_FILENEUROFX2021 = \"path/to/sscbd.RData\")`"
+ )
+ }
+
+ res
+}
+
+
+# Evaluate neural net: code based on Rudiyanto et al. 2021
+eval_nnet <- function(X, W1, W2) {
+ N <- nrow(X)
+ # from input layer to hidden layer
+ xt <- rbind(t(X), matrix(1, nrow = 1, ncol = N))
+ h <- W1 %*% xt
+ # activation function
+ y1 <- tanh(h)
+ # from hidden layer to output layer
+ t(W2 %*% rbind(y1, matrix(1, nrow = 1, ncol = N)))
+}
+
+# Iterate over neuroFX2021: code based on Rudiyanto et al. 2021
+iterate_neuroFX <- function(x, nfx, niter = 50) {
+ res <- array(dim = c(niter, nrow(x), 6))
+
+ # loop though n iteration
+ for (k in seq_len(niter)) {
+ # Predict theta_sat, log(alpha), log(n-1), m
+ res[k, , 1:4] <- eval_nnet(
+ x,
+ W1 = nfx[["tW1"]][k, , ],
+ W2 = nfx[["tW2"]][k, , ]
+ )
+ # Predict log10(K_sat), L
+ res[k, , 5:6] <- eval_nnet(
+ x,
+ W1 = nfx[["kW1"]][k, , ],
+ W2 = nfx[["kW2"]][k, , ]
+ )
+ }
+
+ res
+}
+
+
+#' Check Soil Water Retention Curve parameters
+#'
+#' @inheritParams SWRCs
+#'
+#' @section Notes:
+#' The argument selecting `SWRC` (`swrc_name`) is recycled
+#' for multiple parameter sets, i.e., rows of `swrcp`.
+#'
+#' @section Details:
+#' [swrc_names()] lists implemented `SWRCs`.
+#'
+#' @seealso [ptf_estimate()]
+#'
+#' @examples
+#' swrc_name <- "Campbell1974"
+#' ptf_name <- "Cosby1984AndOthers"
+#' swrcp <- ptf_estimate(
+#' sand = c(0.5, 0.3),
+#' clay = c(0.2, 0.1),
+#' fcoarse = c(0, 0),
+#' swrc_name = swrc_name,
+#' ptf_name = ptf_name
+#' )
+#'
+#' check_swrcp(swrc_name, swrcp)
+#' check_swrcp(swrc_name, swrcp[1, ])
+#'
+#' swrcp2 <- swrcp
+#' swrcp2[1, 1] <- -10
+#' check_swrcp(swrc_name, swrcp2)
+#'
+#' @export
+#' @md
+check_swrcp <- function(swrc_name, swrcp) {
+ # lengths of arguments are checked by `C_rSW2_SWRC_check_parameters()`
+ .Call(
+ C_rSW2_SWRC_check_parameters,
+ swrc_type = rep_len(
+ encode_name2swrc(swrc_name)[1],
+ if (is.matrix(swrcp)) nrow(swrcp) else 1
+ ),
+ swrcp = swrcp
+ )
+}
+
+
+
+#------ Soil Water Retention Curves ------
+
+#' Conversion between bulk soil water content and soil water potential
+#'
+#' @inheritParams SWRCs
+#' @param direction A character string. Indicates the direction of
+#' soil water conversion.
+#' @param x A numeric value, vector, or matrix.
+#' The soil water values to be converted,
+#' either soil water potential (units `[MPa]`) of the soil matric component or
+#' bulk volumetric water content (units `[cm/cm]`).
+#' @param outer_if_equalsize A logical value.
+#' Relevant only if `x` of length `l` and soils of length `d` are equal.
+#' If `TRUE`, then the returned object has a size of `l x d` = `l x l`
+#' where the `d` sets of soil values are repeated for each value of `x`.
+#' If `FALSE` (default), then the returned object has a size of `l` = `d`
+#' where the the `SWRC` conversion is applied to the
+#' first element of `x` and soils, the second elements, and so on.
+#'
+#' @return The dimensions of the output are a function of `x` and the
+#' number of soil values (e.g., rows or length of `swrc[["swrcp"]]`).
+#' The returned object has:
+#' \itemize{
+#' \item length `l` if both `x` and soils are of length `l`.
+#' \item length `l` if `x` has length `l` and there is one soil.
+#' \item length `d` if `x` is one value and soils are of length `d`.
+#' \item size `l x d` if `x` has length `l` and soils are of length `d`
+#' (if `l` and `d` are not equal or `outer_if_equalsize` is `TRUE`;
+#' cf. the first case);
+#' the `d` sets of soil values are repeated for each value of `x`.
+#' \item size `l x d` if `x` has size `l x d` and there is one soil.
+#' the soil is repeated for each value of `x`.
+#' \item size `l x d` if `x` has size `l x d` and soils are of length `d`
+#' the `d` sets of soil values are repeated for each row of `x`.
+#' }
+#'
+#'
+#' @inherit SWRCs references
+#'
+#' @section Details:
+#' [swrc_names()] lists implemented `SWRCs`;
+#' [ptf_names()] lists implemented `PTFs`; and
+#' [check_ptf_availability()] checks availability of `PTFs`.
+#'
+#' @section Details:
+#' For backward compatibility, `fcoarse` and `layer_width` may be missing.
+#' If they are missing, then the soils are assumed to contain
+#' `0%` coarse fragments and be represented by `1 cm` wide soil layers.
+#'
+#' @section Details:
+#' Arguments `sand`, `clay`, and `bdensity` are only required
+#' if `SWRC` parameter values need to be estimated on the fly,
+#' i.e., if `swrc` does not contain the element `swrcp`
+#' (with suitable `SWRC` parameter values).
+#' This is handled by [ptf_estimate()] and additionally requires
+#' the element `ptf_name` for argument `swrc`.
+#'
+#' @section Details:
+#' If `swrc` contains element `swrcp` with one set of `SWRC` parameters,
+#' i.e., one row, then the parameter set is repeated for each value of `x`.
+#'
+#' @section Details:
+#' If `vwc` inputs represent the matric component
+#' (instead of expected bulk values), then set `fcoarse` to 0.
+#' This works, however, only if `swrcp` are provided or `fcoarse` is not
+#' utilized by the requested `PTF`.
+#'
+#'
+#' @seealso
+#' [ptf_estimate()],
+#' [check_swrcp()],
+#' [check_ptf_availability()]
+#'
+#' @examples
+#' fsand <- c(0.5, 0.3)
+#' fclay <- c(0.2, 0.1)
+#' fcrs1 <- c(0, 0)
+#' fcrs2 <- c(0.4, 0.1)
+#'
+#' swrc1 <- list(
+#' name = "Campbell1974",
+#' swrcp = ptf_estimate(
+#' sand = fsand,
+#' clay = fclay,
+#' fcoarse = fcrs1,
+#' swrc_name = "Campbell1974",
+#' ptf_name = "Cosby1984"
+#' )
+#' )
+#' swrc_swp_to_vwc(-1.5, fcoarse = fcrs1, swrc = swrc1)
+#' swrc_swp_to_vwc(c(-1.5, NA), fcoarse = fcrs1, swrc = swrc1)
+#' swrc_swp_to_vwc(-1.5, fcoarse = fcrs1, sand = fsand, clay = fclay)
+#' swrc_vwc_to_swp(c(0.10, 0.15, 0.20), fcoarse = fcrs1, swrc = swrc1)
+#' swrc_vwc_to_swp(c(0.10, NA, 0.20), fcoarse = fcrs1, swrc = swrc1)
+#'
+#' swrc2 <- list(
+#' name = "Campbell1974",
+#' swrcp = ptf_estimate(
+#' sand = fsand,
+#' clay = fclay,
+#' fcoarse = fcrs2,
+#' swrc_name = "Campbell1974",
+#' ptf_name = "Cosby1984"
+#' )
+#' )
+#' swrc_swp_to_vwc(-1.5, fcoarse = fcrs2, swrc = swrc2)
+#' (1 - fcrs2) * swrc_swp_to_vwc(-1.5, swrc = swrc2)
+#' swrc_swp_to_vwc(-1.5, fcoarse = fcrs2, sand = fsand, clay = fclay)
+#' swrc_vwc_to_swp(c(0.10, 0.15, 0.20), fcoarse = fcrs2, swrc = swrc2)
+#'
+#'
+#' # Available water holding capacity "AWC"
+#' soils <- swSoils_Layers(rSOILWAT2::sw_exampleData)
+#' p <- ptf_estimate(
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' fcoarse = soils[, "gravel_content"]
+#' )
+#' tmp <- swrc_swp_to_vwc(
+#' c(-1.5, -0.033),
+#' fcoarse = soils[, "gravel_content"],
+#' swrc = list(name = "Campbell1974", swrcp = p)
+#' )
+#' awc <- diff(c(0, soils[, "depth_cm"])) * as.vector(diff(tmp))
+#'
+#'
+#' # Shape of SWRCs
+#' theta <- seq(0.05, 0.55, by = 0.001)
+#' soils <- data.frame(
+#' sand_frac = c(sand = 0.92, silty_loam = 0.17, silty_clay = 0.06),
+#' clay_frac = c(0.03, 0.13, 0.58),
+#' bd = c(1.614, 1.464, 1.437)
+#' )
+#' phi <- list(
+#' Campbell1974 = swrc_vwc_to_swp(
+#' theta,
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' swrc = list(swrc_name = "Campbell1974", ptf_name = "Cosby1984")
+#' )
+#' )
+#'
+#' if (check_ptf_availability("Rosetta3")) {
+#' phi[["vanGenuchten1980"]] <- swrc_vwc_to_swp(
+#' theta,
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' bdensity = soils[, "bd"],
+#' swrc = list(swrc_name = "vanGenuchten1980", ptf_name = "Rosetta3")
+#' )
+#' }
+#'
+#' # Use PTF "neuroFX2021" to estimate parameters of SWRC `FXW`
+#' \dontrun{
+#' # Set neuroFX2021 file path, see details in `ptf_neuroFX2021_for_FXW()`
+#' options(RSW2_FILENEUROFX2021 = "path/to/sscbd.RData")
+#' }
+#'
+#' if (check_ptf_availability("neuroFX2021")) {
+#' phi[["FXW"]] <- swrc_vwc_to_swp(
+#' theta,
+#' sand = soils[, "sand_frac"],
+#' clay = soils[, "clay_frac"],
+#' bdensity = soils[, "bd"],
+#' swrc = list(swrc_name = "FXW", ptf_name = "neuroFX2021")
+#' )
+#' }
+#'
+#' if (interactive() && requireNamespace("graphics")) {
+#' par_prev <- graphics::par(mfcol = c(length(phi), 1))
+#'
+#' for (k in seq_along(phi)) {
+#' graphics::matplot(
+#' theta, -phi[[k]],
+#' type = "l",
+#' log = "y",
+#' xlim = c(0, max(theta)),
+#' xlab = "theta [m/m]",
+#' ylim = c(1e-4, 1e6),
+#' ylab = "-phi [MPa]",
+#' main = paste0("Soil Water Retention Curve (", names(phi)[k], ")")
+#' )
+#' graphics::abline(h = -c(-1.5, -0.033), col = "gray", lty = 3)
+#' graphics::legend("topright", rownames(soils), col = 1:3, lty = 1:3)
+#' }
+#'
+#' graphics::par(par_prev)
+#' }
+#'
+#'
+#' @export
+#' @md
+swrc_conversion <- function(
+ direction = c("swp_to_vwc", "vwc_to_swp"),
+ x,
+ fcoarse,
+ layer_width,
+ swrc,
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+) {
+ #--- Check inputs
+ direction <- match.arg(direction)
+
+ # `name` can be used as short form of `swrc_name`
+ if (!("swrc_name" %in% names(swrc)) && "name" %in% names(swrc)) {
+ swrc[["swrc_name"]] <- swrc[["name"]]
+ }
+
+ stopifnot("swrc_name" %in% names(swrc))
+ swrc[["swrc_name"]] <- std_swrc(swrc[["swrc_name"]])[1]
+ swrc[["swrc_type"]] <- encode_name2swrc(swrc[["swrc_name"]])
+
+
+ # Do we need to estimate swrcp?
+ swrc[["swrcp"]] <- if (
+ "swrcp" %in% names(swrc) && !is.null(swrc[["swrcp"]])
+ ) {
+ if (is.null(dim(swrc[["swrcp"]]))) {
+ matrix(swrc[["swrcp"]], nrow = 1)
+ } else {
+ as.matrix(swrc[["swrcp"]])
+ }
+ }
+
+ # Do we have sufficient information to estimate swrcp?
+ if (is.null(swrc[["swrcp"]])) {
+ if (
+ !all(c("swrc_name", "ptf_name") %in% names(swrc)) ||
+ is.null(sand) || is.null(clay)
+ ) {
+ stop("Insufficient information to estimate SWRC parameters.")
+ }
+ }
+
+
+ # Do we have sufficient soil parameters?
+ if (missing(fcoarse) && missing(layer_width)) {
+ ntmp <- if (!is.null(swrc[["swrcp"]])) {
+ nrow(swrc[["swrcp"]])
+ } else {
+ if (!is.null(sand)) {
+ length(sand)
+ } else if (!is.null(clay)) {
+ length(clay)
+ }
+ }
+
+ if (!is.null(ntmp)) {
+ fcoarse <- rep(0, ntmp)
+ layer_width <- rep(1, ntmp)
+ } else {
+ stop("Insufficient soil parameters to use SWRC.")
+ }
+
+ } else if (missing(fcoarse)) {
+ fcoarse <- rep(0, length(layer_width))
+ } else if (missing(layer_width)) {
+ layer_width <- rep(1, length(fcoarse))
+ }
+
+ # Put together available soil parameters and check for consistency
+ soils <- list(
+ fcoarse = fcoarse,
+ layer_width = layer_width
+ )
+
+ if (is.null(swrc[["swrcp"]])) {
+ soils <- c(
+ soils,
+ list(sand = sand, clay = clay),
+ if (!is.null(bdensity)) list(bdensity = bdensity)
+ )
+ }
+
+ nsoils <- unique(lengths(soils))
+
+ if (length(nsoils) > 1) {
+ stop("Soil variables have different lengths.")
+ }
+
+ if (!is.null(swrc[["swrcp"]]) && nrow(swrc[["swrcp"]]) != nsoils) {
+ stop("Dimensions of `swrcp` and length of soil variables disagree.")
+ }
+
+
+ #--- Determine dimensions of data and result
+ nrx <- NROW(x)
+ ncx <- NCOL(x)
+ nx <- nrx * ncx
+ nx1d <- nrx == 1 || ncx == 1
+
+ res <- array(dim = c(nrx, ncx))
+
+
+ #--- Prepare inputs and make SWRC conversion
+ if (
+ nx1d && (nx == 1 || nsoils == 1 || (nx == nsoils && !outer_if_equalsize))
+ ) {
+
+ # 1a. x [len = 1] + soils [len = 1] --> res [len = 1, dim = 1 x 1]
+ # nothing to prepare
+
+ if (nx == 1 && nsoils > 1) {
+ # 2. x [len = 1] + soils [len = d] --> res [len = d, dim = 1 x d]
+ x <- rep_len(x, nsoils)
+
+ } else if (nx > 1 && nx1d && nsoils == 1) {
+ # 3. x [len = l] + soils [len = 1] --> res [len = l, dim = l x 1]
+ soils <- lapply(soils, rep_len, length.out = nx)
+ if (!is.null(swrc[["swrcp"]])) {
+ swrc[["swrcp"]] <- swrc[["swrcp"]][rep(1, nx), , drop = FALSE]
+ }
+
+ } else if (nx == nsoils && !outer_if_equalsize) {
+ # 1b. x [len = l] + soils [len = l] --> res [len = l, dim = l x 1]
+ x <- as.vector(unlist(x))
+ }
+
+ if (is.null(swrc[["swrcp"]])) {
+ swrc[["swrcp"]] <- ptf_estimate(
+ sand = soils[["sand"]],
+ clay = soils[["clay"]],
+ fcoarse = soils[["fcoarse"]],
+ bdensity = soils[["bdensity"]],
+ swrc_name = swrc[["swrc_name"]],
+ ptf_name = swrc[["ptf_name"]]
+ )
+ }
+
+ res <- swrc_conversion_1d(direction, x, soils, swrc, verbose)
+
+ } else if (nx1d && nx > 1 && nsoils > 1) {
+ # 4. x [len = l] + soils [len = d] -> res [dim = l x d]
+ # (x repeated for each soil)
+
+ if (is.null(swrc[["swrcp"]])) {
+ swrc[["swrcp"]] <- ptf_estimate(
+ sand = soils[["sand"]],
+ clay = soils[["clay"]],
+ fcoarse = soils[["fcoarse"]],
+ bdensity = soils[["bdensity"]],
+ swrc_name = swrc[["swrc_name"]],
+ ptf_name = swrc[["ptf_name"]]
+ )
+ }
+
+ tmp <- lapply(
+ x,
+ function(v) {
+ swrc_conversion_1d(direction, rep_len(v, nsoils), soils, swrc, verbose)
+ }
+ )
+ res <- matrix(unlist(tmp), nrow = nx, ncol = nsoils, byrow = TRUE)
+
+ } else if (nx > 1 && !nx1d && nsoils == 1) {
+ # 5. x [dim = l x d] + soils [len = 1] --> res [dim = l x d]
+ soils <- lapply(soils, rep_len, length.out = nrx)
+
+ if (is.null(swrc[["swrcp"]])) {
+ swrc[["swrcp"]] <- ptf_estimate(
+ sand = soils[["sand"]],
+ clay = soils[["clay"]],
+ fcoarse = soils[["fcoarse"]],
+ bdensity = soils[["bdensity"]],
+ swrc_name = swrc[["swrc_name"]],
+ ptf_name = swrc[["ptf_name"]]
+ )
+ } else {
+ swrc[["swrcp"]] <- swrc[["swrcp"]][rep(1, nrx), , drop = FALSE]
+ }
+
+ res <- vapply(
+ seq_len(ncx),
+ function(k) swrc_conversion_1d(direction, x[, k], soils, swrc, verbose),
+ FUN.VALUE = rep(1, nrx),
+ USE.NAMES = FALSE
+ )
+
+
+ } else if (nx > 1 && !nx1d && nsoils == ncx) {
+ # 6. x [dim = l x d] + soils [len = d] --> res [dim = l x d]
+ # (soils repeated for row of x value)
+
+ if (is.null(swrc[["swrcp"]])) {
+ swrc[["swrcp"]] <- ptf_estimate(
+ sand = soils[["sand"]],
+ clay = soils[["clay"]],
+ fcoarse = soils[["fcoarse"]],
+ bdensity = soils[["bdensity"]],
+ swrc_name = swrc[["swrc_name"]],
+ ptf_name = swrc[["ptf_name"]]
+ )
+ }
+
+ swrc[["swrc_type"]] <- rep_len(swrc[["swrc_type"]], nsoils)
+
+ res <- vapply(
+ seq_len(ncx),
+ function(k) {
+ ids <- rep.int(k, nrx)
+ swrc_conversion_1d(
+ direction,
+ x = x[, k],
+ soils = lapply(soils, function(sp) sp[ids]),
+ swrc = list(
+ swrc_type = swrc[["swrc_type"]][ids],
+ swrcp = swrc[["swrcp"]][ids, , drop = FALSE]
+ ),
+ verbose = verbose
+ )
+ },
+ FUN.VALUE = rep(1, nrx),
+ USE.NAMES = FALSE
+ )
+
+ } else {
+ stop("Unsuitable inputs.")
+ }
+
+ res
+}
+
+
+#' Helper function of \code{swrc_conversion} to access underlying C code
+#' @noRd
+swrc_conversion_1d <- function(direction, x, soils, swrc, verbose) {
+
+ prev_verbosity <- sw_verbosity(verbose = as.logical(verbose))
+ on.exit(sw_verbosity(prev_verbosity))
+
+ # lengths of arguments are checked by `C_rSW2_SWRC()`
+ nx <- length(x)
+
+ switch(
+ EXPR = direction,
+ # C_rSW2_SWRC(direction = 1) returns [cm] convert to [cm/cm]
+ swp_to_vwc = 1 / soils[["layer_width"]] * .Call(
+ C_rSW2_SWRC,
+ # x = SWP [MPa] convert to [-bar]
+ x = - 10 * x,
+ direction = 1L,
+ swrc_type = rep_len(swrc[["swrc_type"]], nx),
+ swrcp = swrc[["swrcp"]],
+ fcoarse = soils[["fcoarse"]],
+ width = soils[["layer_width"]]
+ ),
+ # C_rSW2_SWRC(direction = 2) returns [-bar] convert to [MPa]
+ vwc_to_swp = - 0.1 * .Call(
+ C_rSW2_SWRC,
+ # x = VWC (bulk) [cm/cm] convert to SWC [cm]
+ x = x * soils[["layer_width"]],
+ direction = 2L,
+ swrc_type = rep_len(swrc[["swrc_type"]], nx),
+ swrcp = swrc[["swrcp"]],
+ fcoarse = soils[["fcoarse"]],
+ width = soils[["layer_width"]]
+ )
+ )
+}
+
+
+
+#' @describeIn swrc_conversion Convenience wrapper
+#' to convert from `SWP` to bulk `VWC` with selected `SWRC`
+#'
+#' @param swp_MPa A numeric object. The soil water potential values
+#' (units `[MPa]`) of the soil matric component to be converted to
+#' bulk volumetric water content
+#' (i.e., relative to the whole soil; units `[cm/cm]`).
+#'
+#' @export
+#' @md
+swrc_swp_to_vwc <- function(
+ swp_MPa,
+ fcoarse,
+ layer_width,
+ swrc = list(swrc_name = NULL, ptf_name = NULL, swrcp = NULL),
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+) {
+ swrc_conversion(
+ direction = "swp_to_vwc",
+ x = swp_MPa,
+ sand = sand,
+ clay = clay,
+ fcoarse = fcoarse,
+ bdensity = bdensity,
+ layer_width = layer_width,
+ swrc = swrc,
+ outer_if_equalsize = outer_if_equalsize,
+ verbose = verbose
+ )
+}
+
+
+
+#' @describeIn swrc_conversion Convenience wrapper
+#' to convert from bulk `VWC` to matric `SWP` with selected `SWRC`
+#'
+#' @param vwcBulk A numeric object. The volumetric water content values
+#' (relative to the whole soil; units `[cm/cm]`)
+#' to be converted to soil water potential (units `[MPa]`)
+#' of the soil matric component.
+#'
+#' @export
+#' @md
+swrc_vwc_to_swp <- function(
+ vwcBulk,
+ fcoarse,
+ layer_width,
+ swrc = list(swrc_name = NULL, ptf_name = NULL, swrcp = NULL),
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+) {
+ swrc_conversion(
+ direction = "vwc_to_swp",
+ x = vwcBulk,
+ sand = sand,
+ clay = clay,
+ fcoarse = fcoarse,
+ bdensity = bdensity,
+ layer_width = layer_width,
+ swrc = swrc,
+ outer_if_equalsize = outer_if_equalsize,
+ verbose = verbose
+ )
+}
diff --git a/R/sw_Vegetation.R b/R/sw_Vegetation.R
index 3ceb131c..5e5be3d8 100644
--- a/R/sw_Vegetation.R
+++ b/R/sw_Vegetation.R
@@ -134,7 +134,8 @@
#'
#' ## All estimable vegetation types are estimated:
#' estimate_PotNatVeg_composition(
-#' MAP_mm = 10 * clim1[["MAP_cm"]], MAT_C = clim1[["MAT_C"]],
+#' MAP_mm = 10 * clim1[["MAP_cm"]],
+#' MAT_C = clim1[["MAT_C"]],
#' mean_monthly_ppt_mm = 10 * clim1[["meanMonthlyPPTcm"]],
#' mean_monthly_Temp_C = clim1[["meanMonthlyTempC"]]
#' )
@@ -150,7 +151,8 @@
#' ## Some land cover types are fixed and others are estimated, and
#' ## the C4-grass adjustment is used:
#' estimate_PotNatVeg_composition(
-#' MAP_mm = 10 * clim2[["MAP_cm"]], MAT_C = clim2[["MAT_C"]],
+#' MAP_mm = 10 * clim2[["MAP_cm"]],
+#' MAT_C = clim2[["MAT_C"]],
#' mean_monthly_ppt_mm = 10 * clim2[["meanMonthlyPPTcm"]],
#' mean_monthly_Temp_C = clim2[["meanMonthlyTempC"]],
#' dailyC4vars = clim2[["dailyC4vars"]],
@@ -161,14 +163,43 @@
#' ## Fix total grass cover and annual grass cover,
#' ## but estimate relative proportions of C3 and C4 grasses:
#' estimate_PotNatVeg_composition(
-#' MAP_mm = 10 * clim2[["MAP_cm"]], MAT_C = clim2[["MAT_C"]],
+#' MAP_mm = 10 * clim2[["MAP_cm"]],
+#' MAT_C = clim2[["MAT_C"]],
#' mean_monthly_ppt_mm = 10 * clim2[["meanMonthlyPPTcm"]],
#' mean_monthly_Temp_C = clim2[["meanMonthlyTempC"]],
#' dailyC4vars = clim2[["dailyC4vars"]],
-#' fix_sumgrasses = TRUE, SumGrasses_Fraction = 0.8,
-#' fix_annuals = TRUE, Annuals_Fraction = 0.3
+#' fix_sumgrasses = TRUE,
+#' SumGrasses_Fraction = 0.8,
+#' fix_annuals = TRUE,
+#' Annuals_Fraction = 0.3
#' )
#'
+#'
+#' ## SOILWAT2 uses the same algorithm internally if requested to do so
+#' # Obtain cover values from SOILWAT2 output
+#' swin <- rSOILWAT2::sw_exampleData
+#' swin@prod@veg_method <- 1L
+#' swout <- sw_exec(swin)
+#' tmp <- slot(slot(swout, "BIOMASS"), "Year")
+#' pnvsim <- tmp[1, grep("fCover", colnames(tmp)), drop = TRUE]
+#'
+#' # Directly calculate cover values
+#' climex <- calc_SiteClimate(weatherList = get_WeatherHistory(swin))
+#' pnvex <- estimate_PotNatVeg_composition(
+#' MAP_mm = 10 * climex[["MAP_cm"]],
+#' MAT_C = climex[["MAT_C"]],
+#' mean_monthly_ppt_mm = 10 * climex[["meanMonthlyPPTcm"]],
+#' mean_monthly_Temp_C = climex[["meanMonthlyTempC"]]
+#' )[["Rel_Abundance_L1"]]
+#'
+#' # They are identical
+#' identical(pnvsim[["fCover_shrub"]], pnvex[["SW_SHRUB"]])
+#' identical(pnvsim[["fCover_grass"]], pnvex[["SW_GRASS"]])
+#' identical(pnvsim[["fCover_forbs"]], pnvex[["SW_FORBS"]])
+#' identical(pnvsim[["fCover_tree"]], pnvex[["SW_TREES"]])
+#' identical(pnvsim[["fCover_BareGround"]], pnvex[["SW_BAREGROUND"]])
+#'
+#'
#' @export
estimate_PotNatVeg_composition <- function(MAP_mm, MAT_C,
mean_monthly_ppt_mm, mean_monthly_Temp_C, dailyC4vars = NULL,
@@ -185,431 +216,69 @@ estimate_PotNatVeg_composition <- function(MAP_mm, MAT_C,
fill_empty_with_BareGround = TRUE,
warn_extrapolation = TRUE) {
- veg_types <- c(
- "Succulents", "Forbs",
- "Grasses_C3", "Grasses_C4", "Grasses_Annuals",
- "Shrubs", "Trees",
- "BareGround"
- )
- Nveg <- length(veg_types)
-
- isuc <- 1 # succulents
- ifor <- 2 # forbs
- igc3 <- 3 # grasses-C3
- igc4 <- 4 # grasses-C4
- igan <- 5 # grasses-annuals
- ishr <- 6 # shrubs
- itre <- 7 # trees
- ibar <- 8 # bare-ground
-
- veg_cover <- rep(0, Nveg)
-
- # groups without climate-equations, i.e., always set to a specific value
- iset <- c(igan, itre, ibar)
-
- # groups with climate-equations to estimate relative abundance
- iestim <- c(igc4, igc3, ishr, ifor, isuc)
- igrasses <- c(igc3, igc4, igan)
-
-
- #--- Get the user specified fractions: input cover fraction values:
- input_cover <- rep(NA, Nveg)
-
- # Groups that are either fixed or 0, i.e., cannot be NA = not estimated
- input_cover[igan] <- if (fix_annuals) {
- rSW2utils::finite01(Annuals_Fraction)
- } else {
- 0
- }
- input_cover[itre] <- if (fix_trees) {
- rSW2utils::finite01(Trees_Fraction)
- } else {
- 0
- }
- input_cover[ibar] <- if (fix_BareGround) {
- rSW2utils::finite01(BareGround_Fraction)
- } else {
- 0
- }
-
- # Groups that are either fixed or estimated based on climate-relationships
- input_cover[igc4] <- if (fix_C4grasses) C4_Fraction else NA
- input_cover[igc3] <- if (fix_C3grasses) C3_Fraction else NA
- input_cover[ishr] <- if (fix_shrubs) Shrubs_Fraction else NA
- input_cover[ifor] <- if (fix_forbs) Forbs_Fraction else NA
- input_cover[isuc] <- if (fix_succulents) Succulents_Fraction else NA
-
- # treat negative input values as if NA
- input_cover <- rSW2utils::cut0Inf(input_cover, val = NA)
-
-
- #--- Check individual components if the sum of grasses is fixed
- fix_sumgrasses <- fix_sumgrasses && isTRUE(!is.na(SumGrasses_Fraction))
-
- if (fix_sumgrasses) {
- SumGrasses_Fraction <- rSW2utils::cut0Inf(SumGrasses_Fraction, val = 0)
-
- input_sum_grasses <- rSW2utils::replace_NAs_with_val(
- x = sum(input_cover[igrasses], na.rm = TRUE),
- val_replace = 0
- )
-
- add_sum_grasses <- SumGrasses_Fraction - input_sum_grasses
-
- if (add_sum_grasses < 0) {
- stop(
- "'estimate_PotNatVeg_composition': ",
- "User defined grass values including C3, C4, and annuals ",
- "sum to more than user defined total grass cover."
+ res <- .Call(C_rSW2_estimate_PotNatVeg_composition,
+ MAP_mm,
+ MAT_C,
+ mean_monthly_ppt_mm,
+ mean_monthly_Temp_C,
+ shrub_limit,
+ if (fix_sumgrasses) {
+ as.numeric(SumGrasses_Fraction)
+ } else {
+ NA_real_
+ },
+ as.logical(fill_empty_with_BareGround),
+ as.logical(warn_extrapolation),
+ if (is.null(dailyC4vars) || anyNA(dailyC4vars[1:3])) {
+ NULL
+ } else {
+ as.numeric(dailyC4vars[1:3])
+ },
+ as.logical(isNorth),
+ as.logical(fix_BareGround),
+ if (fix_succulents) {
+ as.numeric(Succulents_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_annuals) {
+ as.numeric(Annuals_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_C4grasses) {
+ as.numeric(C4_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_C3grasses) {
+ as.numeric(C3_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_shrubs) {
+ as.numeric(Shrubs_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_forbs) {
+ as.numeric(Forbs_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_trees) {
+ as.numeric(Trees_Fraction)
+ } else {
+ NA_real_
+ },
+ if (fix_BareGround) {
+ as.numeric(BareGround_Fraction)
+ } else {
+ NA_real_
+ }
)
- }
-
- ids_to_estim_grasses <- is.na(input_cover[igrasses])
-
- if (add_sum_grasses > 0) {
- if (sum(ids_to_estim_grasses) == 1) {
- # One grass component to estimate: difference from rest
- input_cover[igrasses[ids_to_estim_grasses]] <-
- SumGrasses_Fraction - input_sum_grasses
-
- add_sum_grasses <- 0
- }
-
- } else {
- # No grass component to add: set all to zero
- input_cover[igrasses[ids_to_estim_grasses]] <- 0
- }
- }
-
-
- #--- Decide if all fractions are sufficiently defined or if they need to be
- # estimated based on climate reltionships
- input_sum <- sum(input_cover, na.rm = TRUE)
- ifixed <- unique(c(iset, which(!is.na(input_cover))))
-
- ids_to_estim <- which(is.na(input_cover))
- n_to_estim <- length(ids_to_estim)
-
- if (input_sum > 1) {
- stop(
- "'estimate_PotNatVeg_composition': ",
- "User defined relative abundance values sum to more than ",
- "1 = full land cover."
- )
- }
-
-
- #--- Incomplete surface cover
- veg_cover <- input_cover
-
- if (n_to_estim <= 1) {
- #--- Less than one component to estimate: no need for equations
-
- if (n_to_estim == 0) {
- #--- All fixed, nothing to estimate
- if (fill_empty_with_BareGround) {
- veg_cover[ibar] <- 1 - sum(veg_cover[-ibar], na.rm = TRUE)
-
- } else if (input_sum < 1) {
- stop(
- "'estimate_PotNatVeg_composition': ",
- "User defined relative abundance values are all fixed, ",
- "but their sum is smaller than 1 = full land cover."
- )
- }
-
- } else if (n_to_estim == 1) {
- #--- One value to estimate: difference from rest
- veg_cover[ids_to_estim] <- 1 - input_sum
- }
-
- } else {
- #---Potential natural vegetation
- # i.e., (input_sum < 1 && sum(is.na(input_cover)) > 1) is TRUE;
- # thus, estimate relative abundance fractions based on climate relationships
-
- if (MAP_mm <= 1) {
- # No precipitation ==> no vegetation, only bare-ground
- # TODO: what about fog?
- veg_cover[] <- 0
- veg_cover[ibar] <- 1
-
- } else {
-
- estim_cover <- rep(NA, Nveg)
-
- # Estimate climate variables
- if (isNorth) {
- Months_WinterTF <- c(12, 1:2)
- Months_SummerTF <- 6:8
- } else {
- Months_WinterTF <- 6:8
- Months_SummerTF <- c(12, 1:2)
- }
-
- # Fraction of precipitation falling during summer/winter months
- ppt.SummerToMAP <- sum(mean_monthly_ppt_mm[Months_SummerTF]) / MAP_mm
- ppt.WinterToMAP <- sum(mean_monthly_ppt_mm[Months_WinterTF]) / MAP_mm
-
- # Temperature in July minus temperature in January
- therm_amp <- mean_monthly_Temp_C[Months_SummerTF[2]] -
- mean_monthly_Temp_C[Months_WinterTF[2]]
-
- if (warn_extrapolation) {
- # Adjust climate variables to limits underlying the data used to develop
- # equations Paruelo & Lauenroth (1996): "The selected sites cover a
- # range of MAT from 2 C to 21.2 C and a range of precipitation (MAP)
- # from 117 to 1011 mm"
-
- # MAT limits:
- if (MAT_C < 1) {
- # Note: MAT = 1 C as limit instead of 2 C based on empirical testing;
- # also because log(x) is undefined for x < 0 and results in negative
- # values for x < 1. Hence the threshold of 1.
- warning(
- "Equations used outside supported range (2 - 21.2 C): ",
- "MAT = ", round(MAT_C, 2), " C reset to 1 C."
- )
- MAT_C <- 1
- }
-
- if (MAT_C > 21.2) {
- warning(
- "Equations used outside supported range (2 - 21.2 C): ",
- "MAT = ", round(MAT_C, 2), " C."
- )
- }
-
- if (MAP_mm < 117 || MAP_mm > 1011) {
- warning(
- "Equations used outside supported range (117-1011 mm): ",
- "MAP = ", round(MAP_mm), " mm."
- )
- }
- }
-
-
- # 1. step: estimate relative abundance based on
- # Paruelo & Lauenroth (1996): shrub climate-relationship:
- if (MAP_mm < 1) {
- estim_cover[ishr] <- 0
- } else {
- # if not enough winter precipitation for a given MAP, then equation
- # results in negative values which we set to 0
- estim_cover[ishr] <- rSW2utils::cut0Inf(
- 1.7105 - 0.2918 * log(MAP_mm) + 1.5451 * ppt.WinterToMAP,
- val = 0
- )
- }
-
- # Paruelo & Lauenroth (1996): C4-grass climate-relationship:
- if (MAT_C <= 0) {
- estim_cover[igc4] <- 0
- } else {
- # if either MAT < 0 or not enough summer precipitation or
- # too cold for a given MAP, then equation results in negative values
- # which we set to 0
- estim_cover[igc4] <- rSW2utils::cut0Inf(
- -0.9837 + 0.000594 * MAP_mm +
- 1.3528 * ppt.SummerToMAP + 0.2710 * log(MAT_C),
- val = 0
- )
-
- # 2. step: Teeri JA, Stowe LG (1976)
- # This equations give percent species/vegetation -> use to limit
- # Paruelo's C4 equation, i.e., where no C4 species => C4 abundance == 0
- if (is.list(dailyC4vars)) {
- if (dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"] <= 0) {
- grass_c4_species <- 0
- } else {
- x10 <- dailyC4vars["Month7th_NSadj_MinTemp_C"] * 9 / 5 + 32
- x13 <- dailyC4vars["DegreeDaysAbove65F_NSadj_DaysC"] * 9 / 5
- x18 <- log(dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"])
- grass_c4_species <- as.numeric(
- (1.60 * x10 + 0.0086 * x13 - 8.98 * x18 - 22.44) / 100
- )
- }
-
- if (grass_c4_species <= rSW2_glovars[["tol"]]) {
- estim_cover[igc4] <- 0
- }
- }
- }
-
- # Paruelo & Lauenroth (1996): C3-grass climate-relationship:
- if (ppt.WinterToMAP <= 0) {
- c3_in_grassland <- c3_in_shrubland <- NA
- } else {
- # if not enough winter precipitation or too warm for a
- # given MAP, then equation results in negative values which we set to 0
- c3_in_grassland <- rSW2utils::cut0Inf(
- 1.1905 - 0.02909 * MAT_C + 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 1,
- val = 0
- )
- c3_in_shrubland <- rSW2utils::cut0Inf(
- 1.1905 - 0.02909 * MAT_C + 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 2,
- val = 0
- )
- }
-
- temp <- estim_cover[ishr] >= shrub_limit && !is.na(estim_cover[ishr])
- estim_cover[igc3] <- ifelse(temp, c3_in_shrubland, c3_in_grassland)
-
- # Paruelo & Lauenroth (1996): forb climate-relationship:
- if (MAP_mm < 1 || MAT_C <= 0) {
- estim_cover[ifor] <- NA
- } else {
- estim_cover[ifor] <- rSW2utils::cut0Inf(
- -0.2035 + 0.07975 * log(MAP_mm) - 0.0623 * log(MAT_C),
- val = 0
- )
- }
-
- # Paruelo & Lauenroth (1996): succulent climate-relationship:
- if (therm_amp <= 0 || ppt.WinterToMAP <= 0) {
- estim_cover[isuc] <- NA
- } else {
- estim_cover[isuc] <- rSW2utils::cut0Inf(
- -1 + 1.20246 * therm_amp ^ -0.0689 * ppt.WinterToMAP ^ -0.0322,
- val = 0
- )
- }
-
- # 3. step:
- ngood <- sum(!is.na(estim_cover[iestim]))
-
- # Any remaining NAs are set to 0
- estim_cover[iestim] <- rSW2utils::replace_NAs_with_val(
- x = estim_cover[iestim],
- val_replace = 0
- )
-
- if (!fill_empty_with_BareGround && ngood <= 1) {
- #--- Hack if some of the equations produced NAs:
- # [these rules are made up arbitrarily by drs, Nov 2012]:
- # If no or only one successful equation, then add
- # 100% C3 if MAT < 10 C,
- # 100% shrubs if MAP < 600 mm, and
- # 100% C4 if MAT >= 10C & MAP >= 600 mm
- if (MAP_mm < 600) {
- estim_cover[ishr] <- 1 + estim_cover[ishr]
- }
-
- if (MAT_C < 10) {
- estim_cover[igc3] <- 1 + estim_cover[igc3]
- }
-
- if (MAT_C >= 10 && MAP_mm >= 600) {
- estim_cover[igc4] <- 1 + estim_cover[igc4]
- }
- }
-
-
- # 4. step: put all together:
- # 4-i) groups with set values (iset) and groups with estimable but
- # fixed values (iestim & !is.na)
- veg_cover[ifixed] <- input_cover[ifixed]
-
- # 4-ii) rescale grass components to fixed total grass cover
- if (fix_sumgrasses && add_sum_grasses > 0) {
- ids_to_estim_grasses <- intersect(ids_to_estim, igrasses)
- n_to_estim_grasses <- sum(ids_to_estim_grasses)
-
- estim_grasses_cover_sum <- sum(estim_cover[ids_to_estim_grasses])
-
- if (estim_grasses_cover_sum > 0) {
- estim_cover[ids_to_estim_grasses] <-
- estim_cover[ids_to_estim_grasses] *
- add_sum_grasses / estim_grasses_cover_sum
-
- } else if (n_to_estim_grasses > 0) {
- # We estimated zero grass cover, but some was required
- # --> divide requested amount evenly
- estim_cover[ids_to_estim_grasses] <-
- add_sum_grasses / n_to_estim_grasses
-
- warning(
- "'estimate_PotNatVeg_composition': ",
- "Total grass cover set, but no grass cover estimated; ",
- "requested cover evenly divided among grass types."
- )
- }
- }
-
- # 4-iii) groups with values to estimate (iestim & is.na):
- veg_cover[ids_to_estim] <- estim_cover[ids_to_estim]
-
- if (fix_sumgrasses) {
- # Fix grasses and remove them from estimable
- ifixed <- unique(c(ifixed, igrasses))
- ids_to_estim <- setdiff(ids_to_estim, igrasses)
- }
-
- # Scale fractions to 0-1 with a sum equal to 1 (if needed)
- tot_veg_cover_sum <- sum(veg_cover)
-
- if (abs(tot_veg_cover_sum - 1) > rSW2_glovars[["tol"]]) {
-
- estim_cover_sum <- sum(estim_cover[ids_to_estim])
-
- if (estim_cover_sum > 0) {
- # Scale estimable fractions so that total sums to 1, but
- # scaling doesn't affect those that are fixed
- veg_cover[ids_to_estim] <- veg_cover[ids_to_estim] *
- (1 - sum(veg_cover[ifixed])) / estim_cover_sum
-
- } else {
- # cover to estimate is 0 and fixed_cover_sum < 1
- if (fill_empty_with_BareGround && !fix_BareGround) {
- # ==> fill land cover up with bare-ground
- veg_cover[ibar] <- 1 - sum(veg_cover[-ibar])
-
- } else {
- stop(
- "'estimate_PotNatVeg_composition': ",
- "The estimated vegetation cover values are 0, ",
- "the user fixed relative abundance values sum to less than 1, ",
- "and bare-ground is fixed. ",
- "Thus, the function cannot compute ",
- "complete land cover composition."
- )
- }
- }
- }
-
- }
- }
-
- names(veg_cover) <- veg_types
-
- # Scale relative grass components to one (or set to 0)
- c3c4ann <- veg_cover[igrasses]
- grass_fraction <- sum(c3c4ann)
-
- if (grass_fraction > 0) {
- c3c4ann <- c3c4ann / grass_fraction
- }
-
- # Return values
- temp <- unname(veg_cover)
-
- list(
- # Full resolution: suitable for STEPWAT2
- Rel_Abundance_L0 = veg_cover,
-
- # SOILWAT2 land cover types:
- Rel_Abundance_L1 = c(
- SW_TREES = temp[itre],
- SW_SHRUB = temp[ishr],
- SW_FORBS = temp[ifor] + temp[isuc],
- SW_GRASS = grass_fraction,
- SW_BAREGROUND = temp[ibar]
- ),
-
- # Relative contributions of sub-types to the grass type
- Grasses = c3c4ann
- )
+ res
}
@@ -720,6 +389,7 @@ estimate_PotNatVeg_composition <- function(MAP_mm, MAT_C,
#' )
#'
#' ## Plot reference and adjusted monthly values
+#' if (interactive()) {
#' par_prev <- par(mfrow = c(2, 1))
#'
#' plot(
@@ -749,6 +419,7 @@ estimate_PotNatVeg_composition <- function(MAP_mm, MAT_C,
#' lines(1:12, phen_adj[, 2])
#'
#' par(par_prev)
+#' }
#'
#' @export
adj_phenology_by_temp <- function(x, ref_temp, target_temp, x_asif = NULL) {
@@ -1310,6 +981,7 @@ Grass_ANPP <- function(MAP_mm) 0.646 * MAP_mm - 102.5
#' Adjust mean monthly biomass values by precipitation
#' @section Details: Internally used by
#' \code{\link{estimate_PotNatVeg_biomass}}.
+#' @noRd
adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals,
biom_maxs, map_mm_shrubs, map_mm_std_shrubs,
map_mm_grasses, map_mm_std_grasses,
@@ -1387,8 +1059,8 @@ adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals,
#' climate relationships
#'
#' @inheritParams adj_phenology_by_temp
-#' @param MAP_mm A numeric value. Mean annual precipitation in millimeter of the
-#' location.
+#' @param target_MAP_mm A numeric value. Mean annual precipitation
+#' in millimeter of the location.
#' @param tr_VegBiom A data.frame with 12 rows (one for each month) and columns
#' \code{X.Biomass}, \code{X.Amount.Live}, \code{X.Perc.Live}, and
#' \code{X.Litter} where \code{X} are for the functional groups shrubs,
@@ -1401,17 +1073,17 @@ adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals,
#' @param do_adjust_biomass A logical value. If \code{TRUE} then monthly biomass
#' is adjusted by precipitation.
#' @param fgrass_c3c4ann A numeric vector of length 3. Relative contribution
-#' [0-1] of the C3-grasses, C4-grasses, and annuals functional groups. The sum
-#' of \code{fgrass_c3c4ann} is 1.
+#' `[0-1]` of the C3-grasses, C4-grasses, and annuals functional groups.
+#' The sum of `fgrass_c3c4ann` is 1.
#'
#' @section Default inputs: \itemize{
#' \item Shrubs are based on location \var{\sQuote{IM_USC00107648_Reynolds}}
-#' which resulted in a vegetation composition of 70 \% shrubs and 30 \%
+#' which resulted in a vegetation composition of 70 % shrubs and 30 %
#' C3-grasses. Default monthly biomass values were estimated for
#' MAP = 450 mm yr-1.
#' \item Grasses are based on location \var{\sQuote{GP_SGSLTER}}
-#' (shortgrass steppe) which resulted in 12 \% shrubs, 22 \% C3-grasses,
-#' and 66 \% C4-grasses. Default biomass values were estimated for
+#' (shortgrass steppe) which resulted in 12 % shrubs, 22 % C3-grasses,
+#' and 66 % C4-grasses. Default biomass values were estimated for
#' MAP = 340 mm yr-1.
#' \item Mean monthly reference temperature are the median values across
#' 898 big sagebrush sites
@@ -1422,10 +1094,12 @@ adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals,
#' a matrix with 12 rows (one for each month) and columns \code{Biomass},
#' \code{Amount.Live}, \code{Perc.Live}, and \code{Litter}.
#'
-#' @seealso Function \code{\link{adjBiom_by_ppt}} is called
-#' if \code{do_adjust_biomass};
-#' function \code{\link{adj_phenology_by_temp}} is called
-#' if \code{do_adjust_phenology}.
+#' @section Details:
+#' If `do_adjust_biomass`, then the internal function `adjBiom_by_ppt()` is
+#' used to adjust biomass by annual precipitation amount.
+#' If `do_adjust_phenology`, then the exported function
+#' [adj_phenology_by_temp()] is used to adjust the seasonal pattern of biomass
+#' (phenology) by monthly temperature.
#'
#' @references Bradford, J.B., Schlaepfer, D.R., Lauenroth, W.K. & Burke, I.C.
#' (2014). Shifts in plant functional types have time-dependent and regionally
@@ -1452,6 +1126,7 @@ adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals,
#' )
#'
#' @export
+#' @md
estimate_PotNatVeg_biomass <- function(
target_temp,
target_MAP_mm,
@@ -1629,12 +1304,29 @@ estimate_PotNatVeg_biomass <- function(
#' \item second row of datafile is source of data
#' \item the other rows contain the data for each distribution type = columns
#' }
-#' @section Note: cannot write data from \var{\sQuote{sw_input_soils}} to
-#' \var{\sQuote{datafile.soils}}
+#'
+#' @param tr_input_code
+#' The `"desc"` component of [`rSOILWAT2::sw2_trco_table`].
+#' @param tr_input_coeff
+#' The `"data"` component of [`rSOILWAT2::sw2_trco_table`].
+#' @param soillayer_no An integer value. The number of soil layers.
+#' @param trco_type A character string. A column name of `tr_input_code`.
+#' @param layers_depth An integer vector. The lower depths of soil layers [`cm`]
+#' @param adjustType A character string. The method to adjust prescribed
+#' coefficient profile onto provided depth profile `layers_depth`.
+#'
+#' @seealso [estimate_PotNatVeg_roots()] with example code
+#'
#' @export
-TranspCoeffByVegType <- function(tr_input_code, tr_input_coeff,
- soillayer_no, trco_type, layers_depth,
- adjustType = c("positive", "inverse", "allToLast")) {
+#' @md
+TranspCoeffByVegType <- function(
+ tr_input_code,
+ tr_input_coeff,
+ soillayer_no,
+ trco_type,
+ layers_depth,
+ adjustType = c("positive", "inverse", "allToLast")
+) {
#extract data from table by category
trco.code <- as.character(tr_input_code[,
@@ -1885,10 +1577,19 @@ estimate_PotNatVeg_roots <- function(
#' \link[rSOILWAT2:swProd-class]{rSOILWAT2::swProd} object
#'
#' @param fg A character string. One of the functional groups represented by
-#' \pkg{rSOILWAT2}
-#' @param use A logical vector.
+#' \pkg{rSOILWAT2}
+#' @param use A named logical vector. The names must represent the column
+#' names of a `MonthlyVeg` element of an [`swProd-class`] object
+#' @param prod_input A data frame. The values that replace the selected
+#' biomass values.
+#' @param prod_default A [`swProd-class`] object that contains
+#' the `MonthlyVeg` element with biomass values to be updated.
+#'
+#' @return The requested `MonthlyVeg` element from `prod_default` with updated
+#' values.
#'
#' @export
+#' @md
update_biomass <- function(
fg = c("Grass", "Shrub", "Tree", "Forb"),
use, # nolint: function_argument_linter.
diff --git a/R/sw_dbW_WeatherDatabase.R b/R/sw_dbW_WeatherDatabase.R
index ae075e61..9b485f3c 100644
--- a/R/sw_dbW_WeatherDatabase.R
+++ b/R/sw_dbW_WeatherDatabase.R
@@ -18,6 +18,90 @@
###############################################################################
+#--- Topic: weather data ------
+#' `rSOILWAT2` weather data functionality
+#'
+#' @param wd A list of elements of class [`swWeatherData-class`]
+#' that each hold daily weather data for one calendar year.
+#' @param weatherData A list of elements of class [`swWeatherData-class`]
+#' that each hold daily weather data for one calendar year.
+#' @param dailySW A list of elements of class [`swWeatherData-class`]
+#' that each hold daily weather data for one calendar year.
+#'
+#' @param weatherDF A `data.frame`. Daily weather data where rows represent
+#' days and columns represent the weather variables
+#' (see `weatherDF_dataColumns`).
+#' @param weatherDF_dataColumns A vector of character strings. The column
+#' names of `weatherDF` in the correct order for `SOILWAT2` including
+#' calendar year `year` (optional) and day of year `DOY`, see
+#' [weather_dataColumns()].
+#'
+#'
+#' @param years A numeric vector. The calendar years.
+#' @param digits An integer value. The number of decimal places for rounding
+#' weather values.
+#' @param round An integer value. The number of decimal places for rounding
+#' weather values.
+#'
+#' @param weather_tag A character string. The base file name without extension
+#' for `SOILWAT2`-formatted input files; default is `"weath"`
+#'
+#' @name sw_weather_data
+#' @md
+NULL
+
+
+
+#--- Topic: weather data base ------
+#' Weather data base structure
+#'
+#' @param dbFilePath A character string. The file path of the weather database.
+#' This will be a file of type `sqlite3`. In-memory databases are not
+#' supported.
+#' @param site_data A data.frame. The site data with column names
+#' `Longitude`, `Latitude`, and `Label`.
+#' @param Site_id An integer value. The IDs/database key of the queried site.
+#' @param site_id An integer value. The IDs/database key of the queried site.
+#' @param Site_ids An integer vector. The IDs/database keys of the queried sites
+#' @param site_ids An integer vector. The IDs/database keys of the queried sites
+#' @param Labels A vector of character strings. The names/labels of
+#' queried sites.
+#' @param Label A character string. The name/label of the queried site.
+#' @param site_labels A vector of character string. The names/labels of
+#' queried sites.
+#' @param site_label A character string. The name/label of the queried site.
+#' @param lat A numeric vector or `NULL`. The latitude in decimal degrees
+#' of `WGS84`. Northern latitude are positive, sites on the southern
+#' hemisphere have negative values.
+#' @param long A numeric vector or `NULL`. The longitude in decimal degrees
+#' of `WGS84`. Eastern longitudes are positive, sites on the western
+#' hemisphere have negative values.
+#' @param Scenario_ids An integer vector. The IDs/database keys of the queried
+#' scenario.
+#' @param scen_ids An integer vector. The IDs/database keys of the queried
+#' scenario.
+#' @param Scenario_id An integer value The ID/database key of the queried
+#' scenario.
+#' @param scenario_id An integer value The ID/database key of the queried
+#' scenario.
+#' @param Scenarios A vector of character strings. The climate scenarios of
+#' which the first one is enforced to be `scen_ambient`.
+#' @param scen_labels A vector of character strings. The climate scenarios of
+#' which the first one is enforced to be `scen_ambient`.
+#' @param Scenario A character string. The name/label of a climate scenario.
+#' @param scenario A character string. The name/label of a climate scenario.
+#' @param scen_ambient A character string. The first/default climate scenario.
+#' @param startYear A numeric value. First calendar year of the weather data.
+#' @param endYear A numeric value. Last calendar year of the weather data.
+#' @param ignore.case A logical value.
+#' @param verbose A logical value.
+#'
+#' @name sw_weather_database
+#' @md
+NULL
+
+
+
## ------SQLite weather database functions
# Daily weather data is stored in database as SQL-blob of a list of R objects
# of class \code{\linkS4class{swWeatherData}}
@@ -25,7 +109,7 @@
#' Insistently interacting with the weather database
#'
-#' This is particularly suitable for `DBI::dbGetQuery()` and `DBI::dbExecute()`.
+#' This is particularly suitable for [DBI::dbGetQuery()] and [DBI::dbExecute()].
#'
#' @param fun A function.
#' The function must have arguments `conn`, `statement`, and `params` or
@@ -99,6 +183,7 @@ dbW_version <- function() {
}
#' Check that version of registered weather database is up-to-date
+#' @param dbW_min_version A numeric version number.
#' @return A logical value.
#' @export
dbW_check_version <- function(dbW_min_version = NULL) {
@@ -135,20 +220,16 @@ dbW_compression <- function() {
}
+#--- Topic: check_content ------
#' Check availability of content in registered weather database
#'
-#' @param Site_ids An integer vector. The IDs/database keys of the queried site.
-#' @param Labels A vector of character strings. The names/labels of the queried
-#' sites.
-#' @param Scenario_ids An integer vector. The IDs/database keys of the queried
-#' scenario.
-#' @param Scenarios A vector of character strings. The names/labels of the
-#' queried scenarios.
-#' @param ignore.case A logical value.
#' @name check_content
NULL
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details: \code{dbW_has_siteIDs} checks whether sites are available.
#' @return \code{dbW_has_siteIDs} returns a logical vector of the length of
#' queried sites.
@@ -167,6 +248,9 @@ dbW_has_sites <- function(Labels, ignore.case = FALSE) {
}
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details: \code{dbW_has_siteIDs} checks whether sites are available.
#' @return \code{dbW_has_siteIDs} returns a logical vector of the length of
#' queried sites.
@@ -182,6 +266,9 @@ dbW_has_siteIDs <- function(Site_ids) {
}
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details: \code{dbW_has_scenarioIDs} checks whether scenarios are
#' available.
#' @return \code{dbW_has_scenarios} returns a logical vector of the length of
@@ -198,6 +285,9 @@ dbW_has_scenarioIDs <- function(Scenario_ids) {
}
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details: \code{dbW_has_scenarios} checks whether scenarios are
#' available.
#' @return \code{dbW_has_scenarios} returns a logical vector of the length of
@@ -219,6 +309,9 @@ dbW_has_scenarios <- function(Scenarios, ignore.case = FALSE) {
}
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details: \code{dbW_has_weatherData} checks whether weather data are
#' available but ignores \code{start_year} and \code{end_year}.
#'
@@ -285,6 +378,9 @@ dbW_has_weatherData <- function(Site_ids, Scenario_ids) {
#' @rdname check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @section Details:
#' \code{dbW_have_sites_all_weatherData} checks whether weather data are
#' available but ignores \code{start_year} and \code{end_year}.
@@ -301,7 +397,6 @@ dbW_have_sites_all_weatherData <- function(
site_ids = NULL,
scen_labels = NULL,
scen_ids = NULL,
- chunk_size = 1500L,
verbose = FALSE
) {
@@ -359,6 +454,7 @@ dbW_have_sites_all_weatherData <- function(
}
+#--- Topic: extract data from weather data base ------
#' Extract table keys to connect sites with weather data in the registered
#' weather database
@@ -367,15 +463,9 @@ dbW_have_sites_all_weatherData <- function(
#' \code{Labels} or by providing \code{lat} and \code{long} of the requested
#' site(s).
#'
-#' @param lat A numeric vector or \code{NULL}. The latitude in decimal degrees
-#' of \var{WGS84}. Northern latitude are positive, sites on the southern
-#' hemisphere have negative values.
-#' @param long A numeric vector or \code{NULL}. The longitude in decimal degrees
-#' of \var{WGS84}. Eastern longitudes are positive, sites on the western
-#' hemisphere have negative values.
+#' @inheritParams sw_weather_database
#' @param tol_xy A numeric value. The tolerance used to match requested
#' longitude and latitude values.
-#' @inheritParams check_content
#'
#' @return An integer vector with the values of the keys or \code{NA} if not
#' located.
@@ -469,7 +559,7 @@ dbW_getSiteId <- function(
#' Extract table keys to connect scenario(s) with weather data in the registered
#' weather database
#'
-#' @inheritParams check_content
+#' @inheritParams sw_weather_database
#'
#' @return An integer vector with the values of the keys or \code{NA} if not
#' located.
@@ -514,7 +604,10 @@ dbW_getScenarioId <- function(Scenario, ignore.case = FALSE, verbose = FALSE) {
#' }
#'
#'
+#' @inheritParams sw_weather_database
#' @inheritParams dbW_getSiteId
+#' @param add_if_missing A logical value. Should site entries in the data base
+#' be created if they are queried and do not exist in the data base?
#'
#' @return A list with two elements \code{site_id} and \code{scenario_id}.
#'
@@ -681,55 +774,6 @@ dbW_getScenariosTable <- function() {
}
-# Index along years to narrow the start and/or end year if not NULL
-select_years <- function(years, start_year = NULL, end_year = NULL) {
-
- if (!is.null(start_year) || !is.null(end_year)) {
- start_year <- as.integer(start_year)
- use_start <- !is.na(start_year)
- end_year <- as.integer(end_year)
- use_end <- !is.na(end_year)
-
- if (
- use_start && use_end &&
- (start_year >= end_year || start_year < 0 || end_year < 0)
- ) {
- warning(
- "'select_years': wrong value for argument 'start_year' ",
- "and/or 'end_year'"
- )
- }
-
- } else {
- use_start <- use_end <- FALSE
- }
-
- idx_start_year <- 1L
- if (use_start) {
- tmp <- match(start_year, years)
- if (!is.na(tmp)) {
- idx_start_year <- tmp
- }
- }
-
- idx_end_year <- length(years)
- if (use_end) {
- tmp <- match(end_year, years)
- if (!is.na(tmp)) {
- idx_end_year <- tmp
- }
- }
-
- idx_start_year:idx_end_year
-}
-
-#' Extract years from a \var{weatherData} object
-#' @param wd A list of elements of class \code{\linkS4class{swWeatherData}}
-#' @export
-get_years_from_weatherData <- function(wd) {
- as.integer(unlist(lapply(wd, FUN = slot, "year")))
-}
-
#' Extracts daily weather data from a registered weather database
#'
@@ -742,20 +786,12 @@ get_years_from_weatherData <- function(wd) {
#' If there is missing data, then impute or use the built-in Markov
#' weather generator (see examples for \code{\link{sw_exec}}).
#'
-#' @param Site_id Numeric. Used to identify site and extract weather data.
-#' @param lat Numeric. Latitude used with longitude to identify site id if
-#' \code{Site_id} is missing.
-#' @param long Numeric. Longitude and Latitude are used to identify site if
-#' \code{Site_id} is missing.
-#' @param Label A character string. A site label.
-#' @param startYear Numeric. Extracted weather data will start with this year.
-#' @param endYear Numeric. Extracted weather data will end with this year.
-#' @param Scenario A character string.
+#' @inheritParams sw_weather_database
+#' @inheritParams dbW_getSiteId
#' @param stop_if_missing A logical value. If \code{TRUE}, then throws an
#' error if at least one requested weather data object is not available
#' in the current weather database. If \code{FALSE}, then returns \code{NULL}
#' for those requested site scenario combinations.
-#' @inheritParams dbW_getSiteId
#'
#' @return
#' If one site and one scenario were requested, then returns
@@ -774,6 +810,7 @@ get_years_from_weatherData <- function(wd) {
#' @seealso \code{\link{getWeatherData_folders}}
#'
#' @export
+#' @md
dbW_getWeatherData <- function(
Site_id = NULL,
lat = NULL,
@@ -900,12 +937,11 @@ dbW_getWeatherData <- function(
#' Registers/connects a SQLite weather database with the package
#'
-#' @param dbFilePath A character string. The weather database file path.
-#' @param create_if_missing A logical value. If \code{TRUE} and now file
-#' \code{dbFilePath} exists then create a new file.
+#' @inheritParams sw_weather_database
+#' @param create_if_missing A logical value. If \code{TRUE} and file
+#' \code{dbFilePath} does not exist then create a new database file.
#' @param check_version A logical value. If \code{TRUE} then check database
#' version against currently implemented version by the package.
-#' @param verbose A logical value.
#'
#' @return An invisible logical value indicating success/failure.
#'
@@ -1003,7 +1039,7 @@ dbW_setConnection <- function(
#' @rdname dbW_setConnection
#'
#' @section Details:
-#' `.dbW_setConnection()` is a bare-bones version of `dbW_setConnection()`.
+#' [.dbW_setConnection()] is a bare-bones version of [dbW_setConnection()].
#' It doesn't carry out any checks that make sure the database works
#' correctly.
#'
@@ -1030,13 +1066,21 @@ dbW_disconnectConnection <- function() {
invisible(!inherits(res, "try-error"))
}
+
+#--- Topic: Add data to database ------
+
#' Adds new sites to a registered weather database
#'
-#' @inheritParams check_content
-#' @inheritParams dbW_createDatabase
+#' @inheritParams sw_weather_database
+#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
+#'
+#' @section Details:
+#' `site_data` requires columns `Longitude`, `Latitude`, and `Label`.
+#'
#' @export
+#' @md
dbW_addSites <- function(site_data, ignore.case = FALSE, verbose = FALSE) {
req_cols <- c("Latitude", "Longitude", "Label")
if (!all(req_cols %in% colnames(site_data))) {
@@ -1067,8 +1111,8 @@ dbW_addSites <- function(site_data, ignore.case = FALSE, verbose = FALSE) {
#' Updates existing sites or adds new sites to a registered weather database
#'
-#' @inheritParams check_content
-#' @inheritParams dbW_createDatabase
+#' @inheritParams sw_weather_database
+#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
#' @export
@@ -1110,8 +1154,8 @@ dbW_updateSites <- function(
#' Adds new Scenarios to a registered weather database
#'
-#' @inheritParams check_content
-#' @inheritParams dbW_createDatabase
+#' @inheritParams sw_weather_database
+#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
#' @export
@@ -1169,8 +1213,13 @@ dbW_addWeatherDataNoCheck <- function(
}
#' Adds daily weather data to a registered weather database
-#' @inheritParams check_content
-#' @inheritParams dbW_getWeatherData
+#'
+#' @inheritParams sw_weather_data
+#' @inheritParams sw_weather_database
+#' @inheritParams dbW_getSiteId
+#' @param weatherFolderPath A character string. The path to the parent folder.
+#' @param overwrite A logical value. Should weather data that already exists
+#' in the data base be overwritten?
#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
@@ -1409,23 +1458,19 @@ dbW_addWeatherData <- function(
#' \var{Scenario} (i.e., the scenario name)}
#' }
#'
-#' @param dbFilePath A character string. The file path of the weather database.
-#' This will be a file of type \code{sqlite3}. In-memory databases are not
-#' supported.
-#' @param site_data A data.frame. The site data with column names
-#' \var{Latitude}, \var{Longitude}, and \var{Label}.
-#' @param Scenarios A vector of character strings. The climate scenarios of
-#' which the first one is enforced to be \code{scen_ambient}.
-#' @param scen_ambient A character string. The first/default climate scenario.
+#' @inheritParams sw_weather_database
#' @param compression_type A character string. The type of compression for
#' the weather blob. See \code{\link[base]{memCompress}} for the available
#' choices.
-#' @param verbose A logical value.
#' @param ... Additional/deprecated arguments which are currently ignored.
#'
#' @return \code{TRUE} on success; \code{FALSE} otherwise. If the file
#' \code{dbFilePath} didn't already exist, but creating it failed, then the
#' attempt will be disconnected and removed.
+#'
+#' @section Details:
+#' `site_data` requires columns `Longitude`, `Latitude`, and `Label`.
+#'
#' @export
dbW_createDatabase <- function(
dbFilePath = "dbWeatherData.sqlite3",
@@ -1554,8 +1599,23 @@ dbW_createDatabase <- function(
}
-#dataframe of columns folder, lat, long, label where label can equal folderName
+#' Read `SOILWAT2`-style weather data from disk and store in weather database
+#'
+#' @param MetaData A data frame. If not missing, then must contain columns
+#' (in that order) (name of site weather data) `folder`,
+#' `lat` (site latitude),
+#' `long` (site longitude),
+#' `label` (name of site).
+#' @param FoldersPath A character string. The path to the folder that contains
+#' the site weather data folders.
+#' @param ScenarioName A character string. The scenario name represented by
+#' the data.
+#' @param weather_tag A character string. The file name tag that identifies
+#' the individual weather data files inside the site weather data folders.
+#'
+#'
#' @export
+#' @md
dbW_addFromFolders <- function(
MetaData = NULL,
FoldersPath = ".",
@@ -1602,9 +1662,14 @@ dbW_addFromFolders <- function(
invisible(TRUE)
}
+
+#--- Topic: Delete/remove data from database ------
+
#' Delete a site and all associated weather data from a registered weather
#' database
-#' @inheritParams check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
#' @export
@@ -1624,7 +1689,9 @@ dbW_deleteSite <- function(Site_ids) {
}
#' Delete a weather data record from a registered weather database
-#' @inheritParams check_content
+#'
+#' @inheritParams sw_weather_database
+#'
#' @return An invisible logical value indicating success with \code{TRUE} and
#' failure with \code{FALSE}.
#' @export
@@ -1764,7 +1831,49 @@ dbW_delete_duplicated_weatherData <- function( # nolint: object_length_linter.
}
-## ------ Conversion of weather data formats
+#--- Topic: manipulate weather data objects ------
+
+# Index along years to narrow the start and/or end year if not NULL
+select_years <- function(years, start_year = NULL, end_year = NULL) {
+
+ if (!is.null(start_year) || !is.null(end_year)) {
+ start_year <- as.integer(start_year)
+ use_start <- !is.na(start_year)
+ end_year <- as.integer(end_year)
+ use_end <- !is.na(end_year)
+
+ if (
+ use_start && use_end &&
+ (start_year >= end_year || start_year < 0 || end_year < 0)
+ ) {
+ warning(
+ "'select_years': wrong value for argument 'start_year' ",
+ "and/or 'end_year'"
+ )
+ }
+
+ } else {
+ use_start <- use_end <- FALSE
+ }
+
+ idx_start_year <- 1L
+ if (use_start) {
+ tmp <- match(start_year, years)
+ if (!is.na(tmp)) {
+ idx_start_year <- tmp
+ }
+ }
+
+ idx_end_year <- length(years)
+ if (use_end) {
+ tmp <- match(end_year, years)
+ if (!is.na(tmp)) {
+ idx_end_year <- tmp
+ }
+ }
+
+ idx_start_year:idx_end_year
+}
#' Conversion: (Compressed) raw vector (e.g., SQL-retrieved blob) to
#' (uncompressed) object
@@ -1802,10 +1911,8 @@ dbW_blob_to_weatherData <- function(data_blob, type = "gzip") {
#' weather data used by \pkg{rSOILWAT2}'s simulation functions to a blob object
#' which can be inserted into a SQLite DB.
#'
-#' @param weatherData A list of elements of class
-#' \code{\linkS4class{swWeatherData}} or any suitable object.
-#' @param type A character string. One of
-#' \code{c("gzip", "bzip2", "xz", "none")}.
+#' @inheritParams sw_weather_data
+#' @inheritParams dbW_blob_to_weatherData
#'
#' @seealso \code{\link[base]{memCompress}}, \code{\link{serialize}}
#' @export
@@ -1835,9 +1942,17 @@ dbW_weatherData_to_blob <- function(weatherData, type = "gzip") {
#' \var{weath}.
#' @param startYear Numeric. Extracted weather data will start with this year.
#' @param endYear Numeric. Extracted weather data will end with this year.
+#' @param dailyInputFlags A logical vector of length `MAX_INPUT_COLUMNS`,
+#' see `"weathsetup.in"`.
+#' @param method A character string. `"R"` uses code in `R` to read files as-is
+#' whereas `"C"` uses `"SOILWAT2"` code to read and process files.
#'
#' @return A list of elements of class \code{\linkS4class{swWeatherData}}.
#'
+#' @section Details:
+#' [dbW_weather_to_SOILWATfiles()] offers the inverse operation, i.e.,
+#' writing weather data to disk files.
+#'
#' @seealso \code{\link{dbW_getWeatherData}}
#'
#' @examples
@@ -1845,25 +1960,62 @@ dbW_weatherData_to_blob <- function(weatherData, type = "gzip") {
#' path_demo <- system.file("extdata", "example1", package = "rSOILWAT2")
#'
#' ## ------ Simulation with data prepared beforehand and separate weather data
-#' ## Read inputs from files on disk
+#' ## Read inputs from files on disk (via SOILWAT2)
#' sw_in3 <- sw_inputDataFromFiles(dir = path_demo, files.in = "files.in")
#'
-#' ## Read forcing weather data from files on disk (there are also functions
-#' ## to set up a SQLite database for the weather data)
-#' sw_weath3 <- getWeatherData_folders(
-#' LookupWeatherFolder = file.path(path_demo, "Input"),
-#' weatherDirName = "data_weather", filebasename = "weath",
-#' startYear = 1979, endYear = 2010)
+#' ## Read forcing weather data from files on disk (via SOILWAT2)
+#' sw_weath3c <- getWeatherData_folders(
+#' LookupWeatherFolder = file.path(path_demo, "Input"),
+#' weatherDirName = "data_weather",
+#' filebasename = "weath",
+#' startYear = 1979,
+#' endYear = 2010,
+#' method = "C"
+#' )
+#'
+#' ## Read forcing weather data from files on disk (via R)
+#' sw_weath3r <- getWeatherData_folders(
+#' LookupWeatherFolder = file.path(path_demo, "Input"),
+#' weatherDirName = "data_weather",
+#' filebasename = "weath",
+#' startYear = 1979,
+#' endYear = 2010,
+#' method = "R"
+#' )
+#'
+#' ## Weather data (for the non-calculated variables) should be identical
+#' identical(
+#' sw_weath3c[[1L]]@data[, 1:4],
+#' rSOILWAT2::get_WeatherHistory(sw_in3)[[1L]]@data[, 1:4]
+#' )
+#' identical(
+#' sw_weath3r[[1L]]@data[, 1:4],
+#' rSOILWAT2::get_WeatherHistory(sw_in3)[[1L]]@data[, 1:4]
+#' )
#'
#' ## List of the slots of the input objects of class 'swWeatherData'
-#' utils::str(sw_weath3, max.level=1)
+#' utils::str(sw_weath3c, max.level = 1)
+#' utils::str(sw_weath3r, max.level = 1)
#'
#' ## Execute the simulation run
-#' sw_out3 <- sw_exec(inputData = sw_in3, weatherList = sw_weath3)
+#' sw_out3c <- sw_exec(inputData = sw_in3, weatherList = sw_weath3c)
+#' sw_out3r <- sw_exec(inputData = sw_in3, weatherList = sw_weath3r)
+#'
+#' all.equal(sw_out3c, sw_out3r)
#'
#' @export
-getWeatherData_folders <- function(LookupWeatherFolder, weatherDirName = NULL,
- filebasename = "weath", startYear = NULL, endYear = NULL) {
+#' @md
+getWeatherData_folders <- function(
+ LookupWeatherFolder,
+ weatherDirName = NULL,
+ filebasename = "weath",
+ startYear = NULL,
+ endYear = NULL,
+ dailyInputFlags = c(rep(TRUE, 3L), rep(FALSE, 11L)),
+ method = c("R", "C")
+) {
+
+ method <- match.arg(method)
if (is.null(LookupWeatherFolder) || is.null(filebasename)) {
stop(
@@ -1872,6 +2024,13 @@ getWeatherData_folders <- function(LookupWeatherFolder, weatherDirName = NULL,
)
}
+ stopifnot(
+ identical(
+ length(dailyInputFlags),
+ rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
+ )
+ )
+
dir_weather <- if (is.null(weatherDirName)) {
LookupWeatherFolder
} else {
@@ -1884,23 +2043,54 @@ getWeatherData_folders <- function(LookupWeatherFolder, weatherDirName = NULL,
}
)
- if (!endsWith(filebasename, ".")) {
- filebasename <- paste0(filebasename, ".")
+ if (endsWith(filebasename, ".")) {
+ # remove trailing "."
+ filebasename <- sub("\\.$", "", filebasename)
}
- years <- as.numeric(sub(pattern = filebasename, replacement = "", fweath))
+
+ years <- as.integer(
+ sub(pattern = paste0(filebasename, "."), replacement = "", fweath)
+ )
stopifnot(!anyNA(years))
- index <- select_years(years, startYear, endYear)
+ ids <- select_years(years, startYear, endYear)
+ used_years <- years[ids]
+
+ if (method == "C") {
+ .Call(
+ C_rSW2_readAllWeatherFromDisk,
+ dir_weather,
+ filebasename,
+ used_years[[1L]],
+ used_years[[length(used_years)]],
+ dailyInputFlags
+ )
- weathDataList <- list()
- for (k in seq_along(index)) {
- weathDataList[[k]] <- swReadLines(
- new("swWeatherData", year = years[index[k]]),
- file.path(dir_weather, fweath[index[k]])
+ } else if (method == "R") {
+ ids_cols <- c(1L, 1L + which(dailyInputFlags))
+
+ res <- mapply(
+ function(fname, yr) {
+ object <- new("swWeatherData")
+ object@year <- yr
+ data <- utils::read.table(
+ fname,
+ header = FALSE,
+ comment.char = "#",
+ blank.lines.skip = TRUE,
+ sep = "\t"
+ )
+ stopifnot(ncol(data) %in% (0:1 + sum(dailyInputFlags)))
+ object@data <- object@data[seq_len(nrow(data)), , drop = FALSE]
+ object@data[, ids_cols] <- as.matrix(data)
+ object
+ },
+ file.path(dir_weather, fweath[ids]),
+ used_years,
+ SIMPLIFY = FALSE
)
- }
- names(weathDataList) <- as.character(years[index])
- weathDataList
+ stats::setNames(res, as.character(used_years))
+ }
}
@@ -1931,9 +2121,41 @@ set_missing_weather <- function(data, valNA = NULL) {
data
}
+#' Check which weather values are missing
+#'
+#' @param x A two-dimensional numeric object.
+#'
+#' @return A logical object with same dimensions as `x`
+#'
+#' @examples
+#' x <- data.frame(
+#' Tmax = c(-1.5, 2, NA, 999),
+#' Tmin = c(-5, NaN, 999, -5)
+#' )
+#'
+#' is_missing_weather(x)
+#'
+#' @md
+#' @export
+is_missing_weather <- function(x) {
+ x <- as.matrix(x)
+
+ vals_missing <- c(
+ NA,
+ NaN,
+ rSW2_glovars[["kSOILWAT2"]][["kNUM"]][["SW_MISSING"]]
+ )
+
+ array(
+ data = x %in% vals_missing,
+ dim = dim(x),
+ dimnames = dimnames(x)
+ )
+}
#' Convert an object of class \code{\linkS4class{swWeatherData}} to a data.frame
#'
+#' @inheritParams sw_weather_data
#' @inheritParams set_missing_weather
#'
#' @export
@@ -1951,17 +2173,63 @@ dbW_weatherData_to_dataframe <- function(weatherData, valNA = NULL) {
)
}
-#' Conversion: object of class \code{\linkS4class{swWeatherData}} to
-#' matrix of monthly values (\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})
+#' Round weather data in a list class \code{\linkS4class{swWeatherData}}
+#'
+#' @inheritParams sw_weather_data
+#'
+#' @section Notes:
+#' `weatherDF_dataColumns` lists the columns of `weatherData` to be rounded.
#'
+#' @return A list with \code{\linkS4class{swWeatherData}} elements.
+#'
+#' @export
+#' @md
+dbW_weatherData_round <- function(
+ weatherData,
+ digits = 4L,
+ weatherDF_dataColumns = weather_dataColumns()
+) {
+ lapply(
+ weatherData,
+ function(x) {
+ slot(x, "data")[, weatherDF_dataColumns] <- round(
+ slot(x, "data")[, weatherDF_dataColumns],
+ digits = digits
+ )
+ x
+ }
+ )
+}
+
+
+#' Summarize daily weather to weekly, monthly, or yearly values
+#'
+#' @inheritParams sw_weather_data
#' @inheritParams set_missing_weather
+#' @param time_step A character string.
+#' @param na.rm A logical value. Should missing daily values be removed before
+#' calculating monthly temperature and precipitation.
+#' @param funs A named vector of functions. The names must match column names
+#' in `dailySW` and the function are used to summarize daily weather values.
#'
+#' @md
+#' @name dbW_temporal_summaries
+NULL
+
+#' @rdname dbW_temporal_summaries
#' @export
-dbW_weatherData_to_monthly <- function(dailySW, na.rm = FALSE, valNA = NULL) {
+dbW_weatherData_to_monthly <- function(
+ dailySW,
+ na.rm = FALSE,
+ valNA = NULL,
+ funs = weather_dataAggFun()
+) {
+ vars <- names(funs)
+
monthly <- matrix(
nrow = length(dailySW) * 12,
- ncol = 5,
- dimnames = list(NULL, c("Year", "Month", "Tmax_C", "Tmin_C", "PPT_cm"))
+ ncol = 2 + length(vars),
+ dimnames = list(NULL, c("Year", "Month", vars))
)
for (y in seq_along(dailySW)) {
@@ -1971,31 +2239,29 @@ dbW_weatherData_to_monthly <- function(dailySW, na.rm = FALSE, valNA = NULL) {
format = "%Y-%j", tz = "UTC"
)$mon + 1
tmp <- set_missing_weather(weath@data, valNA = valNA)
- monthly[1:12 + 12 * (y - 1), ] <- data.matrix(cbind(
- Year = weath@year,
- Month = 1:12,
- aggregate(
- tmp[, c("Tmax_C", "Tmin_C")],
- by = list(month),
- FUN = mean,
- na.rm = na.rm
- )[, 2:3],
- PPT_cm = as.vector(
- tapply(tmp[, "PPT_cm"], month, FUN = sum, na.rm = na.rm)
+
+ ids <- 1:12 + 12 * (y - 1)
+ monthly[ids, "Year"] <- weath@year
+ monthly[ids, "Month"] <- seq_len(12L)
+
+ for (var in vars) {
+ monthly[ids, var] <- as.vector(
+ tapply(tmp[, var], month, FUN = funs[[var]], na.rm = na.rm)
)
- ))
+ }
}
monthly
}
-#' Aggregate daily weather data.frame to weekly, monthly, or yearly values
+#' @rdname dbW_temporal_summaries
#' @export
dbW_dataframe_aggregate <- function(
dailySW,
time_step = c("Year", "Month", "Week", "Day"),
- na.rm = FALSE
+ na.rm = FALSE,
+ funs = weather_dataAggFun()
) {
time_step <- match.arg(time_step)
@@ -2034,22 +2300,25 @@ dbW_dataframe_aggregate <- function(
)
}
- as.matrix(cbind(
- hout,
- Tmax_C = as.vector(
- tapply(dailySW[, "Tmax_C"], INDEX = idaggs, FUN = mean, na.rm = na.rm)
- ),
- Tmin_C = as.vector(
- tapply(dailySW[, "Tmin_C"], INDEX = idaggs, FUN = mean, na.rm = na.rm)
- ),
- PPT_cm = as.vector(
- tapply(dailySW[, "PPT_cm"], INDEX = idaggs, FUN = sum, na.rm = na.rm)
+ vars <- names(funs)
+
+ res <- as.matrix(
+ cbind(
+ hout,
+ matrix(ncol = length(vars), dimnames = list(NULL, vars))
)
- ))
+ )
+
+ for (var in vars) {
+ res[, var] <- as.vector(
+ tapply(dailySW[, var], INDEX = idaggs, FUN = funs[[var]], na.rm = na.rm)
+ )
+ }
+
+ res
}
-#' Conversion: object of daily weather data.frame to matrix of monthly values
-#' (\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})
+#' @rdname dbW_temporal_summaries
#' @export
dbW_dataframe_to_monthly <- function(dailySW, na.rm = FALSE) {
dbW_dataframe_aggregate(dailySW, time_step = "Month", na.rm = na.rm)
@@ -2058,22 +2327,34 @@ dbW_dataframe_to_monthly <- function(dailySW, na.rm = FALSE) {
-#' Assign years to weather data.frame
-#' @param weatherDF A data.frame. data.frame containing weather information for
-#' site.
+#' Extract years from a \var{weatherData} object
+#' @inheritParams sw_weather_data
+#' @export
+get_years_from_weatherData <- function(wd) {
+ as.integer(unlist(lapply(wd, FUN = slot, "year")))
+}
+
+
+#' Extract years to weather data.frame
+#'
+#' @inheritParams sw_weather_data
#' @param years A numeric or integer vector or \code{NULL}. Vector of year data
#' where length is equal to either the number of years in the weather data.frame
#' or the number of rows in the data.frame.
-#' @param weatherDF_dataColumns A vector of string values. Column names of the
-#' weather data.frame.
+#'
+#' @section Notes:
+#' The first element of `weatherDF_dataColumns` (only the first is used) must
+#' contain the column name for day of year.
+#'
#' @return A named list of length 2.
#' \itemize{
#' \item \code{years} a vector of unique year values.
#' \item \code{year_ts} a vector of time series values for each row/day of the
#' data.frame.
#' }
+#'
#' @export
-
+#' @md
get_years_from_weatherDF <- function(weatherDF, years, weatherDF_dataColumns) {
if (!is.null(years)) {
if (length(years) == nrow(weatherDF)) {
@@ -2108,24 +2389,30 @@ get_years_from_weatherDF <- function(weatherDF, years, weatherDF_dataColumns) {
#' Conversion: data.frame to object of class \code{\linkS4class{swWeatherData}}
+#'
+#' @inheritParams sw_weather_data
+#'
+#' @section Notes:
+#' `weatherDF_dataColumns` must exactly contain entries for day of year and
+#' the three weather variables.
+#'
#' @export
+#' @md
dbW_dataframe_to_weatherData <- function(
weatherDF,
years = NULL,
- weatherDF_dataColumns = c("DOY", "Tmax_C", "Tmin_C", "PPT_cm"),
+ weatherDF_dataColumns = c("DOY", weather_dataColumns()),
round = 2
) {
if (
- !(length(weatherDF_dataColumns) == 4) ||
- !all(weatherDF_dataColumns %in% colnames(weatherDF))
+ !all(weatherDF_dataColumns %in% colnames(weatherDF))
) {
stop(
- "Not every required weatherDF_dataColumns is available in the ",
+ "Not every weatherDF_dataColumns is available in the ",
"'weatherDF' object"
)
}
-
ylist <- get_years_from_weatherDF(weatherDF, years, weatherDF_dataColumns)
if (isTRUE(is.logical(round) && round || is.numeric(round))) {
@@ -2135,12 +2422,13 @@ dbW_dataframe_to_weatherData <- function(
weatherData <- list()
for (i in seq_along(ylist$years)) {
ydata <- as.matrix(
- weatherDF[ylist$year_ts == ylist$years[i],
- weatherDF_dataColumns]
+ weatherDF[
+ ylist$year_ts == ylist$years[i],
+ weatherDF_dataColumns
+ ]
)
- colnames(ydata) <- c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
- weatherData[[i]] <- new(
- "swWeatherData",
+ colnames(ydata) <- c("DOY", weather_dataColumns())
+ weatherData[[i]] <- swWeatherData(
year = ylist$years[i],
data = ydata
)
@@ -2153,14 +2441,36 @@ dbW_dataframe_to_weatherData <- function(
#' Conversion: object of class \code{\linkS4class{swWeatherData}} or
#' data.frame to \pkg{SOILWAT} input text files
+#'
+#' @param path A character string. Path on disk to where to write files.
+#' @param site.label A character string. Site identification name added to
+#' comment on first line of each file.
+#' @inheritParams sw_weather_data
+#' @param weatherDF A data.frame. Weather data, see details.
+#'
+#' @section Notes:
+#' `weatherDF_dataColumns` must exactly contain entries for day of year and
+#' the three weather variables.
+#'
+#' @section Details:
+#' The weather data must be provided either via `weatherData` or `weatherDF`.
+#' See [dbW_weatherData_to_dataframe()] and [dbW_weatherData_to_dataframe()]
+#' for conversions between formats of `weatherData` and `weatherDF`.
+#'
+#' @section Details:
+#' [getWeatherData_folders()] offers the inverse operation, i.e.,
+#' reading weather data from disk files.
+#'
#' @export
+#' @md
dbW_weather_to_SOILWATfiles <- function(
path,
site.label,
weatherData = NULL,
weatherDF = NULL,
years = NULL,
- weatherDF_dataColumns = c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
+ weatherDF_dataColumns = c("DOY", weather_dataColumns()),
+ digits = 4L
) {
stopifnot(is.null(weatherData) || is.null(weatherDF))
@@ -2171,11 +2481,10 @@ dbW_weather_to_SOILWATfiles <- function(
} else if (!is.null(weatherDF)) {
if (
- !(length(weatherDF_dataColumns) == 4) ||
!all(weatherDF_dataColumns %in% colnames(weatherDF))
) {
stop(
- "Not every required weatherDF_dataColumns is available in the ",
+ "Not every weatherDF_dataColumns is available in the ",
"'weatherDF' object"
)
}
@@ -2200,7 +2509,7 @@ dbW_weather_to_SOILWATfiles <- function(
sw.filename <- file.path(path, paste0("weath.", years[y]))
sw.comments <- c(
paste("# weather for site", site.label, "year = ", years[y]),
- "# DOY Tmax(C) Tmin(C) PPT(cm)"
+ paste0("# ", toString(weatherDF_dataColumns))
)
utils::write.table(
@@ -2213,14 +2522,21 @@ dbW_weather_to_SOILWATfiles <- function(
col.names = FALSE
)
- utils::write.table(
- data.frame(
- data.sw[, 1],
- formatC(data.sw[, 2], digits = 2, format = "f"),
- formatC(data.sw[, 3], digits = 2, format = "f"),
- formatC(data.sw[, 4], digits = 2, format = "f"),
- stringsAsFactors = FALSE
+ tmp <- data.frame(
+ data.sw[, 1],
+ matrix(
+ data = NA_character_,
+ ncol = length(weatherDF_dataColumns) - 1L
),
+ stringsAsFactors = FALSE
+ )
+
+ for (kv in seq_along(weatherDF_dataColumns)[-1]) {
+ tmp[, kv] <- formatC(data.sw[, kv], digits = digits, format = "f")
+ }
+
+ utils::write.table(
+ tmp,
file = sw.filename,
append = TRUE,
sep = "\t",
@@ -2241,6 +2557,7 @@ dbW_weather_to_SOILWATfiles <- function(
#' different years / a subset of years (partially overlapping or not), or
#' can convert from a non-leap to a Gregorian calendar.
#'
+#' @inheritParams sw_weather_data
#' @inheritParams dbW_estimate_WGen_coefs
#' @param new_startYear An integer value. The first Calendar year of the new
#' time period. If \code{NULL}, then the first year of \code{weatherData}.
@@ -2269,25 +2586,32 @@ dbW_weather_to_SOILWATfiles <- function(
#' wdata <- rSOILWAT2::weatherData
#'
#' ## Transfer to different years (partially overlapping)
-#' wnew <- dbW_convert_to_GregorianYears(wdata,
-#' new_startYear = 2000, new_endYear = 2020
+#' wnew <- dbW_convert_to_GregorianYears(
+#' wdata,
+#' new_startYear = 2000,
+#' new_endYear = 2020
#' )
#' all.equal(unique(wnew[, "Year"]), 2000:2020)
#' anyNA(wnew) # --> use `dbW_generateWeather`
#'
#' ## Transfer to a subset of years (i.e., subset)
-#' wnew <- dbW_convert_to_GregorianYears(wdata,
-#' new_startYear = 2000, new_endYear = 2005
+#' wnew <- dbW_convert_to_GregorianYears(
+#' wdata,
+#' new_startYear = 2000,
+#' new_endYear = 2005
#' )
#' all.equal(unique(wnew[, "Year"]), 2000:2005)
#' anyNA(wnew)
#'
#' ## Correct/convert from a non-leap to a Gregorian calendar
-#' wempty <- data.frame(dbW_weatherData_to_dataframe(
-#' list(new("swWeatherData"))))[1:365, ]
-#'
-#' wnew <- dbW_convert_to_GregorianYears(wempty,
-#' new_startYear = 2016, new_endYear = 2016
+#' wempty <- data.frame(
+#' dbW_weatherData_to_dataframe(weatherHistory())
+#' )[1:365, ]
+#'
+#' wnew <- dbW_convert_to_GregorianYears(
+#' wempty,
+#' new_startYear = 2016,
+#' new_endYear = 2016
#' )
#' all.equal(unique(wnew[, "Year"]), 2016:2016)
#' all.equal(nrow(wnew), 366) # leap year
@@ -2300,7 +2624,7 @@ dbW_convert_to_GregorianYears <- function(
type = c("asis", "sequential"),
name_year = "Year",
name_DOY = "DOY",
- name_data = c("Tmax_C", "Tmin_C", "PPT_cm"),
+ name_data = weather_dataColumns(),
valNA = NULL
) {
@@ -2348,19 +2672,23 @@ dbW_convert_to_GregorianYears <- function(
wdata2 <- data.frame(
Year = 1900 + tdays1$year,
DOY = 1 + tdays1$yday,
- var1 = NA,
- var2 = NA,
- var3 = NA
+ matrix(ncol = length(name_data)),
+ stringsAsFactors = FALSE
)
colnames(wdata2) <- c(name_year, name_DOY, name_data)
# Transfer existing values
- tmp <- apply(wdata[, c(name_year, name_DOY)], 1, paste, collapse = "/")
+ tmp <- apply(
+ wdata[, c(name_year, name_DOY), drop = FALSE],
+ MARGIN = 1,
+ FUN = paste,
+ collapse = "/"
+ )
id_xdf <- format(as.Date(tmp, format = "%Y/%j"))
id_xdf2 <- format(as.Date(tdays))
id_match <- match(id_xdf2, id_xdf, nomatch = 0)
- wdata2[id_match > 0, name_data] <- wdata[id_match, name_data]
+ wdata2[id_match > 0, name_data] <- wdata[id_match, name_data, drop = FALSE]
wdata2
}
@@ -2374,94 +2702,83 @@ dbW_convert_to_GregorianYears <- function(
#' represents daily data for one Gregorian year
#'
#' @param x An object.
+#' @param check_all A logical value
#'
#' @return A logical value.
#'
+#' @examples
+#' dbW_check_weatherData(rSOILWAT2::weatherData)
+#' dbW_check_weatherData(weatherHistory())
+#' dbW_check_weatherData(weatherHistory(), check_all = FALSE)
+#'
+#'
#' @export
-dbW_check_weatherData <- function(x) {
- length(x) > 0 &&
- inherits(x, "list") &&
- all(sapply(x, inherits, what = "swWeatherData")) &&
- isTRUE(all.equal(
- unname(sapply(x, function(xyr) nrow(slot(xyr, "data")))),
- 365 + as.integer(
- rSW2utils::isLeapYear(sapply(x, slot, name = "year"))
+dbW_check_weatherData <- function(x, check_all = TRUE) {
+ res <-
+ length(x) > 0 &&
+ inherits(x, "list") &&
+ all(vapply(x, inherits, what = "swWeatherData", FUN.VALUE = NA)) &&
+ all(
+ vapply(
+ x,
+ FUN = function(object) {
+ isTRUE(is.logical(validObject(object, test = TRUE)))
+ },
+ FUN.VALUE = NA
+ )
)
- ))
-}
-# nolint start
-## ------ Scanning of SOILWAT input text files
-readCharacter <- function(text, showWarnings = FALSE) {
- tmp <- strsplit(x = text, split = "\t")[[1]][1]
- unlist(strsplit(x = tmp, split = " "))[1]
-}
+ if (res) {
+ yrs <- vapply(x, slot, name = "year", FUN.VALUE = NA_integer_)
+ ids_check <- !is.na(yrs)
-readInteger <- function(text,showWarnings=FALSE) {
- tmp <- suppressWarnings(as.integer(strsplit(x=text,split="\t")[[1]][1]))
- if(is.na(tmp)) {
- if(showWarnings) print(paste("Line: ",text,sep=""))
- if(showWarnings) print("Not formatted with \t. Going to try [space].")
- tmp <- suppressWarnings(as.integer(strsplit(x=text,split=" ")[[1]][1]))
- if(is.na(tmp)) {
- stop("Bad Line. Or Bad line numbers.")
- }
- }
- return(tmp)
-}
+ if (isTRUE(check_all) || sum(ids_check) > 0) {
+ if (isTRUE(check_all)) {
+ ids_check <- seq_along(x)
+ }
-readLogical <- function(text,showWarnings=FALSE) {
- tmp <- suppressWarnings(as.logical(as.integer(strsplit(x=text,split="\t")[[1]][1])))
- if(is.na(tmp)) {
- if(showWarnings) print(paste("Line: ",text,sep=""))
- if(showWarnings) print("Not formatted with \t. Going to try [space].")
- tmp <- suppressWarnings(as.logical(as.integer(strsplit(x=text,split=" ")[[1]][1])))
- if(is.na(tmp)) {
- stop("Bad Line. Or Bad line numbers.")
- }
- }
- return(tmp)
-}
+ has_days <- vapply(
+ x[ids_check],
+ function(xyr) nrow(slot(xyr, "data")),
+ FUN.VALUE = NA_integer_
+ )
+ expected_days <- 365L + as.integer(rSW2utils::isLeapYear(yrs[ids_check]))
-readNumeric <- function(text,showWarnings=FALSE) {
- tmp <- suppressWarnings(as.numeric(strsplit(x=text,split="\t")[[1]][1]))
- if(is.na(tmp)) {
- if(showWarnings) print(paste("Line: ",text,sep=""))
- if(showWarnings) print("Not formatted with \t. Going to try [space].")
- tmp <- suppressWarnings(as.numeric(strsplit(x=text,split=" ")[[1]][1]))
- if(is.na(tmp)) {
- stop("Bad Line. Or Bad line numbers.")
+ res <- res && identical(unname(has_days), expected_days)
}
}
- return(tmp)
+
+ res
}
-readNumerics <- function(text,expectedArgs,showWarnings=FALSE) {
- tmp <- strsplit(x=text,split="\t")[[1]]
- tmp <- tmp[tmp != ""] #get rid of extra spaces
- if(length(tmp) > expectedArgs) tmp <- tmp[1:expectedArgs] #get rid of comment?
- tmp <- suppressWarnings(as.numeric(tmp))
- if(any(is.na(tmp))) {
- if(showWarnings & any(is.na(tmp))) print(paste("Line: ",text,sep=""))
- if(showWarnings & any(is.na(tmp))) print("Not formatted with \t. Going to try [space].")
- tmp <- strsplit(x=text,split="\t")[[1]][1] #remove comment
- tmp <- strsplit(x=tmp,split=" ")[[1]]
- tmp <- tmp[tmp!=""] #remove extra spaces
- tmp <- suppressWarnings(as.numeric(tmp[1:expectedArgs]))
- if(any(is.na(tmp))) {
- #last try. tried set by \t then by space. Now try both
- tmp <- strsplit(x=text,split=" ",fixed=T)[[1]]
- tmp <- unlist(strsplit(x=tmp,split="\t",fixed=T))
- tmp <- tmp[tmp!=""] #remove extra spaces
- tmp <- suppressWarnings(as.numeric(tmp[1:expectedArgs]))
- if(any(is.na(tmp))) stop("Bad Line. Or Bad line numbers.")
- }
- }
- if(length(tmp) != expectedArgs) {
- if(showWarnings) print(paste("Line: ",text,sep=""))
- stop(paste("Expected ",expectedArgs," Got ",length(tmp),sep=""))
+
+#' Determine used weather variables based on values
+#'
+#' @param x Weather data, i.e.,
+#' a list where each element is of class [`swWeatherData`], or
+#' a data frame with appropriate columns (see [dbW_weatherData_to_dataframe()]).
+#' @param name_data A vector of character strings. The column names of `x`
+#' with weather variables.
+#'
+#' @return A logical vector for each of the possible input variables with
+#' `TRUE` if at least one value is not missing.
+#'
+#' @examples
+#' calc_dailyInputFlags(rSOILWAT2::weatherData)
+#' calc_dailyInputFlags(dbW_weatherData_to_dataframe(rSOILWAT2::weatherData))
+#'
+#'
+#' @md
+#' @export
+calc_dailyInputFlags <- function(x, name_data = weather_dataColumns()) {
+ if (isTRUE(dbW_check_weatherData(x, check_all = FALSE))) {
+ x <- dbW_weatherData_to_dataframe(x)
}
- return(tmp)
+
+ apply(
+ !is_missing_weather(x[, name_data, drop = FALSE]),
+ MARGIN = 2L,
+ FUN = any
+ )
}
-# nolint end
diff --git a/R/sw_dbW_upgrade.R b/R/sw_dbW_upgrade.R
index 7ce78302..8386fa53 100644
--- a/R/sw_dbW_upgrade.R
+++ b/R/sw_dbW_upgrade.R
@@ -23,6 +23,7 @@
#'
#' @param dbWeatherDataFile A character string. The path to the weather database
#' file.
+#' @param SWRunInformation A data frame.
#' @param fbackup A character string. The path to where the weather database
#' should be backed up. If \code{NULL}, then '_copy' is appended to
#' \code{dbWeatherDataFile}.
@@ -36,7 +37,6 @@ NULL
#' that was created under \pkg{Rsoilwat31} to the current package version
#' \pkg{rSOILWAT2}
#'
-#' @inheritParams dbW_upgrade
#' @param check_all A logical value. If \code{TRUE}, then every record is
#' checked; otherwise, only the first record is checked for the package
#' version.
@@ -243,8 +243,6 @@ dbW_upgrade_to_rSOILWAT2 <- function(dbWeatherDataFile, fbackup = NULL,
#' @section Details: \code{dbW_upgrade_v31to32} upgrades a weather database
#' from version 3.1.z' to '3.2.0'
#'
-#' @inheritParams dbW_upgrade
-#'
#' @export
dbW_upgrade_v31to32 <- function(dbWeatherDataFile, fbackup = NULL) {
@@ -334,7 +332,6 @@ dbW_upgrade_v31to32 <- function(dbWeatherDataFile, fbackup = NULL) {
#' @section Details: \code{dbW_upgrade_v3to31} upgrades a weather database
#' from version '3.0.x' to '3.1.0'
#'
-#' @inheritParams dbW_upgrade
#' @param type_new The type of compression used to compress the weather blobs.
#' See \code{\link[base]{memCompress}}.
#'
@@ -447,8 +444,6 @@ dbW_upgrade_v3to31 <- function(dbWeatherDataFile, fbackup = NULL,
#' @section Details: \code{dbW_upgrade_v2to3} upgrades a weather database
#' from version '2.x.y' to '3.0.0'
#'
-#' @inheritParams dbW_upgrade
-#'
#' @export
dbW_upgrade_v2to3 <- function(dbWeatherDataFile, fbackup = NULL) {
con <- DBI::dbConnect(RSQLite::SQLite(), dbname = dbWeatherDataFile)
@@ -493,8 +488,6 @@ dbW_upgrade_v2to3 <- function(dbWeatherDataFile, fbackup = NULL) {
#' @section Details: \code{dbW_upgrade_v1to2} upgrades a weather database
#' from version '1.x.y' to '2.0.0'
#'
-#' @inheritParams dbW_upgrade
-#'
#' @export
dbW_upgrade_v1to2 <- function(
dbWeatherDataFile,
@@ -615,23 +608,33 @@ dbW_upgrade_v1to2 <- function(
}
+#' Run database integrity checks on a weather database
+#'
+#' @param con A [DBI::DBIConnection-class] object.
+#' The connection to a weather database.
+#'
#' @export
+#' @md
check_updatedDB <- function(con) {
- print(paste0(Sys.time(),
- ": 'check_updatedDB' started with database integrity"))
+ print(paste0(
+ Sys.time(),
+ ": 'check_updatedDB' started with database integrity"
+ ))
print(paste0(Sys.time(), ": 'check_updatedDB' started 'quick check'"))
- res <- DBI::dbExecute(con, "PRAGMA quick_check;")
+ res <- DBI::dbExecute(con, "PRAGMA quick_check")
print(res)
print(paste0(Sys.time(), ": 'check_updatedDB' started 'integrity check'"))
- print(DBI::dbExecute(con, "PRAGMA integrity_check;"))
+ print(DBI::dbExecute(con, "PRAGMA integrity_check"))
print(paste0(Sys.time(), ": 'check_updatedDB' started 'foreign key check'"))
- print(DBI::dbExecute(con, "PRAGMA foreign_key_check;"))
+ print(DBI::dbExecute(con, "PRAGMA foreign_key_check"))
print(paste0(Sys.time(), ": 'check_updatedDB' checks indices"))
- print(DBI::dbExecute(con, "PRAGMA index_list(WeatherData);"))
- print(DBI::dbExecute(con,
- "PRAGMA index_info(sqlite_autoindex_WeatherData_1);"))
+ print(DBI::dbExecute(con, "PRAGMA index_list(WeatherData)"))
+ print(DBI::dbExecute(
+ con,
+ "PRAGMA index_info(sqlite_autoindex_WeatherData_1)"
+ ))
}
@@ -640,8 +643,6 @@ check_updatedDB <- function(con) {
#' @section Details: \code{backup_copy} creates a backup copy of a weather
#' database file if not already present
#'
-#' @inheritParams dbW_upgrade
-#'
#' @export
backup_copy <- function(dbWeatherDataFile, fbackup = NULL) {
print(paste(Sys.time(), ": backup database", basename(dbWeatherDataFile)))
diff --git a/R/zzz.R b/R/zzz.R
index 6d17b649..6cdf73dc 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -36,10 +36,7 @@
# 'rSW2_glovars' is defined in rSOILWAT2-package.R
# Variables for interaction with SOILWAT2
- assign("swof", sw_out_flags(), envir = rSW2_glovars)
assign("kSOILWAT2", .Call(C_sw_consts), envir = rSW2_glovars)
- assign("sw_TimeSteps", c("Day", "Week", "Month", "Year"),
- envir = rSW2_glovars)
# Variables for weather database functionality
assign("con", NULL, envir = rSW2_glovars)
@@ -49,6 +46,8 @@
assign("tol", sqrt(.Machine$double.eps), envir = rSW2_glovars)
assign("st_mo", seq_len(12L), envir = rSW2_glovars)
+ # Print SOILWAT2 messages to the console (by default); may turn off later
+ sw_verbosity(TRUE)
invisible()
}
diff --git a/README.md b/README.md
index 3a9ae179..84b38337 100644
--- a/README.md
+++ b/README.md
@@ -29,12 +29,11 @@
[rSFSW2]: https://github.com/DrylandEcology/rSFSW2
[issues]: https://github.com/DrylandEcology/rSOILWAT2/issues
[pull request]: https://github.com/DrylandEcology/rSOILWAT2/pulls
-[guidelines]: https://github.com/DrylandEcology/workflow_guidelines
+[guidelines]: https://github.com/DrylandEcology/DrylandEcologyProtocols
[semantic versioning]: https://semver.org/
[testthat]: https://github.com/r-lib/testthat
[roxygen2]: https://cran.r-project.org/package=roxygen2
-[r-pkgs man]: https://r-pkgs.org/man.html
-[r-pkgs tests]: https://r-pkgs.org/tests.html
+[r-pkgs]: https://r-pkgs.org/
@@ -49,8 +48,9 @@
3. [How to contribute](#contribute)
1. [Code guidelines](#follow_guidelines)
2. [Code documentation](#code_documentation)
- 3. [Code tests](#code_tests)
- 4. [Code versioning](#code_versioning)
+ 3. [Code linting](#code_linting)
+ 4. [Code tests](#code_tests)
+ 5. [Code versioning](#code_versioning)
4. [Additional notes](#more_notes)
@@ -124,13 +124,13 @@ then you may consider using one of the cloud services (no endorsements), e.g.,
GNU-compliant [`make`](https://www.gnu.org/software/make/)
- `git` to download the code
- additionally, on Windows OS:
- - [`Rtools`](http://cran.us.r-project.org/bin/windows/Rtools/)
+ - [`Rtools`](https://cloud.r-project.org/bin/windows/Rtools/)
that match your R version
- on `macOS`:
- `xcode` command line tools
(run `xcode-select --install` on the command line)
- having agreed to the `xcode` license (run `xcodebuild -license`)
- - or, alternatively, the full [`xcode`](https://developer.apple.com/xcode)
+ - or, alternatively, the full [`xcode`](https://developer.apple.com/xcode/)
installation
- optional:
- a minimal `latex` installation (see below) and
@@ -139,7 +139,7 @@ then you may consider using one of the cloud services (no endorsements), e.g.,
#### Example instructions for a minimal `latex` installation
- * install the R package [`tinytex`](https://yihui.name/tinytex/)
+ * install the R package [`tinytex`](https://yihui.org/tinytex/)
```{r}
install.packages("tinytex")
tinytex::install_tinytex()
@@ -241,7 +241,7 @@ merge them into the main branch for release:
#### Code documentation
* This is based on the section
- ['Object documentation' of the book 'R packages' by Wickham][r-pkgs man]
+ ['Documentation' of the book 'R packages' by Wickham][r-pkgs]
* Use [roxygen2][] to write inline code documentation of functions
* Use regular R-style comments to additionally document code
* Update help pages and the `NAMESPACE` file with the command
@@ -251,10 +251,22 @@ merge them into the main branch for release:
+
+
+#### Code linting
+ * Please run `lintr::lint_package()` to confirm that code conforms to
+ our style guide (see file `.lintr`) and update code style where needed
+ before pushing a commit or finalizing a pull-request.
+ * These checks are also run automatically as a github action
+ to confirm that a pull-request meets our requirements for merging.
+
+
+
+
#### Code tests and package checks
* This is based on the section
- ['Testing' of the book 'R packages' by Wickham][r-pkgs tests]
+ ['Testing' of the book 'R packages' by Wickham][r-pkgs]
* Unit tests
* Use [testthat][] to add unit tests to the existing framework
@@ -396,7 +408,7 @@ after they are reviewed and pass required checks.
If the version numbers changes, then the following files must be updated
* `DESCRIPTION`: adjust lines 'Version'
* `NEWS`: add a new section describing pertinent changes to a package user
- (see [`r-pkgs` news](https://r-pkgs.org/release.html#news) and
+ (see section ['NEWS' of the book 'R packages' by Wickham][r-pkgs] and
[`tidyverse` news style](https://style.tidyverse.org/news.html?q=news#news))
diff --git a/data-raw/prepare_testInput_objects.R b/data-raw/prepare_testInput_objects.R
index a5d16948..01564ecb 100755
--- a/data-raw/prepare_testInput_objects.R
+++ b/data-raw/prepare_testInput_objects.R
@@ -1,176 +1,396 @@
#!/usr/bin/env Rscript
-#--- rSOILWAT2: use development version
+# Run this script from the top-level of the source package, e.g.,
+# ```
+# cd rSOILWAT2/
+# Rscript data-raw/prepare_testInput_objects.R
+# ```
+
+#--- Load development version of rSOILWAT2 ------
# load package "methods" in case this script is run via 'Rscript'
library("methods") # nolint: unused_import_linter.
+
# these packages are not listed by `rSOILWAT2`:
+# nolint start: missing_package_linter.
stopifnot(
- requireNamespace("pkgbuild"), # nolint: missing_package_linter.
- requireNamespace("pkgload"), # nolint: missing_package_linter.
- requireNamespace("usethis") # nolint: missing_package_linter.
+ requireNamespace("pkgbuild"),
+ requireNamespace("pkgload"),
+ requireNamespace("usethis"),
+ requireNamespace("waldo")
)
+# nolint end
-pkgbuild::clean_dll() # nolint: namespace_linter.
-pkgload::load_all() # nolint: namespace_linter.
+# nolint start: namespace_linter.
+pkgbuild::clean_dll()
+pkgload::load_all()
+# nolint end
-#--- INPUTS
-dSOILWAT2_inputs <- "testing"
-dir_orig <- file.path("src", "SOILWAT2", dSOILWAT2_inputs)
-dir_in <- file.path("inst", "extdata")
-dir_backup <- sub("extdata", "extdata_copy", dir_in, fixed = TRUE)
-dir_out <- file.path("tests", "test_data")
+#--- Define tests/examples ------
tests <- 1:6
examples <- paste0("example", tests)
+cns <- c(
+ "WeatherGenerator",
+ "SoilTemp",
+ "CO2Effects",
+ "TiltedSurface",
+ "VegEstab"
+)
+define_ex <- rbind(
+ ex1 = c(FALSE, TRUE, TRUE, FALSE, FALSE),
+ ex2 = c(TRUE, TRUE, TRUE, FALSE, FALSE),
+ ex3 = c(FALSE, TRUE, TRUE, FALSE, FALSE),
+ ex4 = c(FALSE, TRUE, TRUE, FALSE, FALSE),
+ ex5 = c(FALSE, TRUE, TRUE, TRUE, FALSE),
+ ex6 = c(FALSE, TRUE, TRUE, FALSE, TRUE)
+)
+colnames(define_ex) <- cns
+
-#-----------------------
-#--- BACKUP PREVIOUS FILES
-print(paste("Create backup of ", shQuote(dir_in), " as", shQuote(dir_backup)))
-dir.create(dir_backup, showWarnings = FALSE)
-stopifnot(dir.exists(dir_backup))
-file.copy(
- from = dir_in,
- to = dir_backup,
- recursive = TRUE,
- copy.mode = TRUE,
- copy.date = TRUE
+#--- Inputs ------
+dSOILWAT2_inputs <- file.path("tests", "example")
+dir_orig <- file.path("src", "SOILWAT2", dSOILWAT2_inputs)
+dir_backup <- "backup"
+dir_extdata <- file.path("inst", "extdata")
+dir_pkgdata <- "data"
+dir_testdata <- file.path("tests", "test_data")
+
+list_backups <- lapply(
+ c(dir_extdata, dir_pkgdata, dir_testdata),
+ function(x) {
+ list(
+ orig = x,
+ delete_orig = if (identical(x, dir_extdata)) {
+ list.files(x, full.names = TRUE)
+ }
+ )
+ }
)
-unlink(dir_in, recursive = TRUE)
-dir.create(dir_in, showWarnings = FALSE)
-stopifnot(dir.exists(dir_in))
-#-----------------------
-#--- COPY AND CREATE EXTDATA EXAMPLES FROM ORIGINAL SOILWAT2 INPUTS
-for (it in seq_along(tests)) {
+
+
+#--- Backup previous version ------
+dir.create(dir_backup, recursive = TRUE, showWarnings = FALSE)
+stopifnot(dir.exists(dir_backup))
+
+for (k in seq_along(list_backups)) {
+ message(
+ "Create backup of ", shQuote(list_backups[[k]][["orig"]]),
+ " at ", shQuote(dir_backup)
+ )
+
file.copy(
- from = dir_orig,
- to = dir_in,
+ from = list_backups[[k]][["orig"]],
+ to = dir_backup,
recursive = TRUE,
copy.mode = TRUE,
copy.date = TRUE
)
- file.rename(
- from = file.path(dir_in, dSOILWAT2_inputs),
- to = file.path(dir_in, examples[it])
+
+ unlink(
+ list_backups[[k]][["delete_orig"]],
+ recursive = TRUE
)
+
+ dir.create(list_backups[[k]][["orig"]], showWarnings = FALSE)
+ stopifnot(dir.exists(list_backups[[k]][["orig"]]))
}
-# example1: default run
- # nothing to do
-# example2: use Markov weather generator
- # Turn on weather generator
- ftemp <- file.path(dir_in, examples[2], "Input", "weathsetup.in")
- fin <- readLines(ftemp)
- line <- grep("Activate/deactivate weather generator", fin, ignore.case = TRUE)
+#------ Helper functions -----
+compare_objects <- function(new, old, tolerance = 1e-9) {
+ # Compare to previous version
+ res_cmp <- waldo::compare(old, new, tolerance = tolerance)
+
+ # Ignore "timestamp"
+ has_timestamp_diff <- grepl("timestamp", res_cmp, fixed = TRUE)
+
+ # Ignore difference in version less than minor
+ vge <- rSOILWAT2::check_version(
+ new,
+ rSOILWAT2::get_version(old),
+ level = "minor"
+ )
+ vle <- rSOILWAT2::check_version(
+ new,
+ rSOILWAT2::get_version(old),
+ level = "minor"
+ )
+ has_version_diff <- !(vge && vle)
+
+ list(
+ res_waldo = res_cmp,
+ resave =
+ length(res_cmp) > sum(has_timestamp_diff) + sum(has_version_diff)
+ )
+}
+
+toggleWeatherGenerator <- function(path, activate = FALSE) {
+ ftmp <- file.path(path, "Input", "weathsetup.in")
+ fin <- readLines(ftmp)
+ line <- grep(
+ "Activate/deactivate weather generator",
+ fin,
+ ignore.case = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line + 1], 1, 1) <- "1"
- writeLines(fin, con = ftemp)
+ substr(fin[line + 1], 1, 1) <- if (activate) "1" else "0"
+ writeLines(fin, con = ftmp)
+}
- # Use partial weather data
+setPartialWeatherData <- function(path) {
unlink(
- file.path(dir_in, examples[2], "Input", "data_weather"),
+ file.path(path, "Input", "data_weather"),
recursive = TRUE
)
- ftemp <- file.path(dir_in, examples[2], "files.in")
- fin <- readLines(ftemp)
- line <- grep("historical weather data", fin, ignore.case = TRUE)
+ ftmp <- file.path(path, "files.in")
+ fin <- readLines(ftmp)
+ line <- grep(
+ "historical weather data",
+ fin,
+ ignore.case = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
fin[line] <- sub(
file.path("Input", "data_weather", "weath"),
file.path("Input", "data_weather_missing", "weath"),
x = fin[line]
)
- writeLines(fin, con = ftemp)
-
+ writeLines(fin, con = ftmp)
+}
-# example3: use soil temperature
- ftemp <- file.path(dir_in, examples[3], "Input", "siteparam.in")
- fin <- readLines(ftemp)
- line <- grep("flag, 1 to calculate soil_temperature", fin, fixed = TRUE)
+toggleSoilTemperature <- function(path, activate = TRUE) {
+ ftmp <- file.path(path, "Input", "siteparam.in")
+ fin <- readLines(ftmp)
+ line <- grep(
+ "flag, 1 to calculate soil_temperature",
+ fin,
+ fixed = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line], 1, 1) <- "1"
- writeLines(fin, con = ftemp)
+ substr(fin[line], 1, 1) <- if (activate) "1" else "0"
+ writeLines(fin, con = ftmp)
+}
-# example4: turn on CO2-effects
- ftemp <- file.path(dir_in, examples[4], "Input", "siteparam.in")
- fin <- readLines(ftemp)
- line <- grep("biomass multiplier", fin, fixed = TRUE)
+toggleCO2Effects <- function(path, activate = TRUE) {
+ ftmp <- file.path(path, "Input", "siteparam.in")
+ fin <- readLines(ftmp)
+ line <- grep(
+ "biomass multiplier",
+ fin,
+ fixed = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line + 1], 1, 1) <- "1"
- line <- grep("water-usage efficiency multiplier", fin, fixed = TRUE)
+ substr(fin[line + 1], 1, 1) <- if (activate) "1" else "0"
+ line <- grep(
+ "water-usage efficiency multiplier",
+ fin,
+ fixed = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line + 1], 1, 1) <- "1"
- writeLines(fin, con = ftemp)
+ substr(fin[line + 1], 1, 1) <- if (activate) "1" else "0"
+ writeLines(fin, con = ftmp)
+}
+
+toggleSurfaceTilt <- function(path, tilt = FALSE, slope = 30, aspect = -45) {
+ ftmp <- file.path(path, "Input", "siteparam.in")
+ fin <- readLines(ftmp)
-# example5: tilted surface
- ftemp <- file.path(dir_in, examples[5], "Input", "siteparam.in")
- fin <- readLines(ftemp)
line <- grep("slope (degrees)", fin, fixed = TRUE)
stopifnot(length(line) == 1, line > 0, line < length(fin))
- fin[line] <- paste0("30", substr(fin[line], 2, nchar(fin[line])))
- line <- grep("aspect = surface azimuth angle (degrees)", fin, fixed = TRUE)
+ tmp <- if (tilt) as.character(slope) else "0"
+ stopifnot(nchar(tmp) <= 2)
+ substr(fin[line], 1, 2) <- paste0(
+ tmp,
+ rep("\t", max(0, 2 - nchar(tmp))),
+ collapse = ""
+ )
+
+ line <- grep(
+ "aspect = surface azimuth angle (degrees)",
+ fin,
+ fixed = TRUE
+ )
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line], 1, 3) <- "-45"
- writeLines(fin, con = ftemp)
+ tmp <- if (tilt) as.character(aspect) else "NAN"
+ stopifnot(nchar(tmp) <= 4)
+ substr(fin[line], 1, 4) <- paste0(
+ tmp,
+ rep("\t", max(0, 4 - nchar(tmp))),
+ collapse = ""
+ )
+ writeLines(fin, con = ftmp)
+}
-# example6: vegetation establishment
- ftemp <- file.path(dir_in, examples[6], "Input", "estab.in")
+
+toggleVegEstab <- function(path, activate = TRUE) {
+ ftemp <- file.path(path, "Input", "estab.in")
fin <- readLines(ftemp)
line <- grep("calculate and output establishment", fin, fixed = TRUE)
stopifnot(length(line) == 1, line > 0, line < length(fin))
- substr(fin[line], 1, 1) <- "1"
+ substr(fin[line], 1, 1) <- if (activate) "1" else "0"
writeLines(fin, con = ftemp)
- ftemp <- file.path(dir_in, examples[6], "Input", "outsetup.in")
+ ftemp <- file.path(path, "Input", "outsetup.in")
fin <- readLines(ftemp)
line <- grep("establishment results", fin, fixed = TRUE)
stopifnot(length(line) == 1, line > 0, line < length(fin))
- fin[line] <- sub("OFF", "AVG", fin[line], fixed = TRUE)
+ fin[line] <- sub(
+ pattern = "OFF",
+ replacement = if (activate) "AVG" else "OFF",
+ x = fin[line],
+ fixed = TRUE
+ )
writeLines(fin, con = ftemp)
+}
+#------- Loop over examples/tests, setup, and create test objects------
+for (it in seq_along(tests)) {
+ message("\n", examples[it], " ----------------------------------")
-#-----------------------
-#--- USE DEFAULT EXTDATA EXAMPLE AS PACKAGE DATA
-sw_exampleData <- rSOILWAT2::sw_inputDataFromFiles(
- file.path(dir_in, examples[1]),
- files.in = "files.in"
-)
-# nolint start: namespace_linter.
-usethis::use_data(sw_exampleData, internal = FALSE, overwrite = TRUE)
-# nolint end
+ dir_ex <- file.path(dir_extdata, examples[it])
+
+ #--- Create raw example input files from original SOILWAT2 inputs ------
+ file.copy(
+ from = dir_orig,
+ to = dir_extdata,
+ recursive = TRUE,
+ copy.mode = TRUE,
+ copy.date = TRUE
+ )
+
+ file.rename(
+ from = file.path(dir_extdata, basename(dSOILWAT2_inputs)),
+ to = dir_ex
+ )
-#-----------------------
-#--- USE EXTDATA EXAMPLES AS BASIS FOR UNIT-TESTS
-for (it in seq_along(tests)) {
+
+ #--- Modify input files for tests ------
+ #--- * example1: default run ------
+
+ #--- * example2: use Markov weather generator ------
+ if (define_ex[it, "WeatherGenerator"]) {
+ toggleWeatherGenerator(dir_ex, activate = TRUE)
+ setPartialWeatherData(dir_ex)
+ }
+
+ #--- * example4: turn on CO2-effects ------
+ toggleCO2Effects(dir_ex, activate = define_ex[it, "CO2Effects"])
+
+ #--- * example3: use soil temperature ------
+ toggleSoilTemperature(dir_ex, activate = define_ex[it, "SoilTemp"])
+
+ #--- * example5: tilted surface ------
+ toggleSurfaceTilt(dir_ex, tilt = define_ex[it, "TiltedSurface"])
+
+ #--- * example6: vegetation establishment ------
+ toggleVegEstab(dir_ex, activate = define_ex[it, "VegEstab"])
+
+
+
+ #--- Base unit tests on default SOILWAT2 inputs ------
+
#---rSOILWAT2 inputs using development version
sw_input <- rSOILWAT2::sw_inputDataFromFiles(
- dir = file.path(dir_in, examples[it]),
+ dir = dir_ex,
files.in = "files.in"
)
- sw_weather <- slot(sw_input, "weatherHistory")
- slot(sw_input, "weatherHistory") <- list(new("swWeatherData"))
- #---Files for unit testing
- saveRDS(
- object = sw_weather,
- file = file.path(dir_out, paste0("Ex", tests[it], "_weather.rds"))
+ #--- Use default SOILWAT2 data as (default) package data ------
+ if (it == 1) {
+ sw_exampleData <- sw_input
+
+ res_cmp <- compare_objects(sw_exampleData, old = rSOILWAT2::sw_exampleData)
+
+ # Save default package data (if different from previous)
+ if (res_cmp[["resave"]]) {
+ print(res_cmp[["waldo_cmp"]])
+
+ message("Update default package data: 'sw_exampleData'")
+
+ # nolint start: namespace_linter.
+ usethis::use_data(sw_exampleData, internal = FALSE, overwrite = TRUE)
+ # nolint end
+ }
+ }
+
+
+ #--- Obtain weather data ------
+ sw_weather <- if (define_ex[it, "WeatherGenerator"]) {
+ # Deal with weather generator (obtain weather input with missing values)
+ toggleWeatherGenerator(dir_ex, activate = FALSE)
+
+ sw_input2 <- rSOILWAT2::sw_inputDataFromFiles(
+ dir = dir_ex,
+ files.in = "files.in"
+ )
+
+ slot(sw_input2, "weatherHistory")
+
+ } else {
+ slot(sw_input, "weatherHistory")
+ }
+
+ stopifnot(rSOILWAT2::dbW_check_weatherData(sw_weather))
+
+ #--- Compare weather to previous version
+ res_cmp <- waldo::compare(
+ readRDS(
+ file.path(
+ dir_backup,
+ basename(dir_testdata),
+ paste0("Ex", tests[it], "_weather.rds")
+ )
+ ),
+ sw_weather
)
- saveRDS(
- object = sw_input,
- file = file.path(dir_out, paste0("Ex", tests[it], "_input.rds"))
+
+
+ #--- Save weather for unit testing (if different from previous)
+ if (length(res_cmp) > 0) {
+ print(res_cmp)
+
+ saveRDS(
+ object = sw_weather,
+ file = file.path(dir_testdata, paste0("Ex", tests[it], "_weather.rds"))
+ )
+ }
+
+
+ #--- Compare input to previous version
+ set_WeatherHistory(sw_input) <- weatherHistory()
+
+ res_cmp <- compare_objects(
+ sw_input,
+ old = readRDS(
+ file.path(
+ dir_backup,
+ basename(dir_testdata),
+ paste0("Ex", tests[it], "_input.rds")
+ )
+ )
)
+ #--- Save input for unit testing (if different from previous)
+ if (res_cmp[["resave"]]) {
+ print(res_cmp[["waldo_cmp"]])
+
+ saveRDS(
+ object = sw_input,
+ file = file.path(dir_testdata, paste0("Ex", tests[it], "_input.rds"))
+ )
+ }
+
- #--- Run with yearly output and save it
+ #--- Run rSOILWAT2 with yearly output and save it as reference output
if (!rSOILWAT2::swWeather_UseMarkov(sw_input)) {
rSOILWAT2::swOUT_TimeStepsForEveryKey(sw_input) <- 3
@@ -181,23 +401,45 @@ for (it in seq_along(tests)) {
quiet = TRUE
)
- saveRDS(
- object = rdy,
- file = file.path(dir_out, paste0("Ex", tests[it], "_output.rds"))
+ #--- Compare ouput to previous version
+ res_cmp <- compare_objects(
+ rdy,
+ old = readRDS(
+ file.path(
+ dir_backup,
+ basename(dir_testdata),
+ paste0("Ex", tests[it], "_output.rds")
+ )
+ )
)
+
+ # Save test output (if different from previous)
+ if (res_cmp[["resave"]]) {
+ print(res_cmp[["waldo_cmp"]])
+
+ saveRDS(
+ object = rdy,
+ file = file.path(dir_testdata, paste0("Ex", tests[it], "_output.rds"))
+ )
+ }
}
-}
-#-----------------------
-#--- DELETE ALL BUT DEFAULT EXAMPLE FROM PACKAGE (to minimize space)
-for (it in seq_along(tests)[-1]) {
- unlink(file.path(dir_in, examples[it]), recursive = TRUE)
+ #--- Only keep default SOILWAT2 files as example input files ------
+ if (it != 1) {
+ unlink(file.path(dir_ex), recursive = TRUE)
+ }
}
-#-----------------------
-print(paste(
- "NOTE: Remove",
+
+message(
+ "NOTE: Remove ",
shQuote(dir_backup),
- "before pushing to repository if script worked well."
+ " before pushing to repository if script worked well."
+)
+
+print(paste(
+ "NOTE: Copy",
+ "'Ex1_input.rds' to 'versioned_swInputData/' as 'Ex1_input_vX.Y.Z.rds'",
+ "if significant changes to any class occurred."
))
diff --git a/data-raw/prepare_weatherData_object.R b/data-raw/prepare_weatherData_object.R
index a6957472..dbc6714e 100755
--- a/data-raw/prepare_weatherData_object.R
+++ b/data-raw/prepare_weatherData_object.R
@@ -23,4 +23,6 @@ weatherData <- rSOILWAT2::getWeatherData_folders(
filebasename = "weath"
)
+stopifnot(rSOILWAT2::dbW_check_weatherData(weatherData))
+
usethis::use_data(weatherData, internal = FALSE) # nolint: namespace_linter.
diff --git a/data/sw_exampleData.rda b/data/sw_exampleData.rda
index 63e10f26..dc107750 100644
Binary files a/data/sw_exampleData.rda and b/data/sw_exampleData.rda differ
diff --git a/data/weatherData.rda b/data/weatherData.rda
index e08e2b36..ef512a39 100644
Binary files a/data/weatherData.rda and b/data/weatherData.rda differ
diff --git a/inst/WORDLIST b/inst/WORDLIST
index 1c7efbcc..f695f504 100644
--- a/inst/WORDLIST
+++ b/inst/WORDLIST
@@ -29,6 +29,7 @@ evapotranspiration
exter
forb
geoscientific
+geotechnical
gregorian
lodgepole
loess
@@ -39,6 +40,7 @@ pedotransfer
phenological
phenology
rangeland
+recalibration
sensu
shortgrass
shrubland
@@ -47,7 +49,9 @@ spatiotemporal
submodule
symlink
toolchain
+tortuosity
transmissivity
+vectorized
xeric
@@ -70,8 +74,12 @@ RCP
README
RMRS
SSP
+SWP
+swrc
+SWRC
th
USGS
+VWC
#------------------------------------
@@ -86,14 +94,21 @@ Canadell
Clapp
codecov
Espinosa
+Fiantis
+Fredlund
Freund
+Genuchten
+Geoderma
Gessner
+Giap
Gidden
Ginn
github
+Goh
Havlina
Hornberger
Innis
+Jin
Kainuma
Krummel
Lamarque
@@ -101,11 +116,14 @@ Lauenroth
Lavin
Luderer
Maestas
+Maggi
Markov
Matsumoto
Meinshausen
Milchunas
+Minasny
Montzka
+Mualem
Nauels
Nicholls
Oecologia
@@ -121,12 +139,15 @@ rhub
Riahi
Rotella
roxygen
-rSOILWAT
rSFSTEP
rSFSW
+rSOILWAT
rSW
+Rudiyanto
Sala
+Schaap
Schlaepfer
+Setiawan
SOILWAT
Springer
SQLite
@@ -140,4 +161,6 @@ Vollmer
Vuuren
Wickham
Wuenschel
+Xing
Zach
+Zhang
diff --git a/inst/extdata/example1/Input/data_weather_daymet/weath.1980 b/inst/extdata/example1/Input/data_weather_daymet/weath.1980
new file mode 100644
index 00000000..ff9cfa49
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_daymet/weath.1980
@@ -0,0 +1,368 @@
+# weather for site daymet example at -105.58 / 39.59 year = 1980
+# DOY, Tmax_C, Tmin_C, PPT_cm, vp_kPa, rsds_WPERm2
+1 -0.37 -9.20 0.28 0.30 160.21
+2 -4.78 -14.96 0.35 0.19 179.14
+3 -3.79 -18.36 0.00 0.13 283.01
+4 -1.30 -11.12 0.00 0.25 230.08
+5 3.08 -8.41 0.00 0.27 253.18
+6 -5.61 -10.70 0.00 0.27 137.65
+7 -8.23 -17.36 0.67 0.16 171.22
+8 -3.68 -17.02 0.31 0.16 215.17
+9 1.01 -12.80 0.36 0.23 219.36
+10 -3.06 -9.67 0.57 0.29 135.10
+11 -1.79 -19.50 0.00 0.13 317.62
+12 -0.30 -13.73 0.54 0.21 222.45
+13 1.26 -6.50 0.00 0.38 205.60
+14 2.69 -5.21 0.00 0.41 208.96
+15 -0.81 -9.70 0.00 0.29 231.93
+16 -1.36 -14.57 0.00 0.20 296.91
+17 -1.22 -13.83 0.00 0.21 292.40
+18 -7.26 -15.12 0.70 0.19 166.46
+19 -5.09 -17.63 0.00 0.15 298.45
+20 0.53 -14.62 0.00 0.20 324.21
+21 -2.89 -14.40 0.00 0.20 288.61
+22 -4.01 -20.04 0.00 0.12 337.75
+23 0.15 -17.90 0.00 0.15 350.72
+24 3.75 -11.23 0.00 0.25 332.46
+25 -3.21 -10.99 0.49 0.26 173.65
+26 -10.02 -23.09 0.39 0.10 248.51
+27 -5.48 -17.48 0.12 0.15 314.07
+28 -6.69 -18.95 0.27 0.14 244.74
+29 -4.01 -16.48 0.29 0.17 248.87
+30 -5.41 -15.51 0.54 0.18 222.64
+31 1.22 -18.80 0.00 0.14 387.42
+32 -0.07 -15.41 0.00 0.18 361.83
+33 -0.65 -9.10 0.00 0.31 257.91
+34 4.30 -7.15 0.00 0.36 317.39
+35 0.21 -6.28 0.00 0.38 211.96
+36 1.02 -10.30 0.00 0.28 322.83
+37 4.99 -9.69 0.00 0.28 368.80
+38 -4.79 -11.23 1.09 0.26 164.79
+39 -2.02 -23.78 0.00 0.09 426.90
+40 0.21 -21.39 0.00 0.11 427.85
+41 0.94 -16.41 0.00 0.17 407.83
+42 -1.09 -17.11 0.00 0.16 399.48
+43 -0.76 -15.28 0.00 0.19 382.90
+44 1.31 -12.04 0.00 0.24 366.80
+45 4.35 -11.54 0.00 0.23 399.98
+46 0.11 -7.11 0.06 0.36 236.38
+47 0.66 -9.39 0.00 0.30 313.71
+48 0.53 -12.77 0.00 0.22 378.66
+49 1.24 -8.00 0.38 0.33 225.90
+50 1.85 -7.81 0.00 0.34 314.88
+51 -0.41 -7.88 0.00 0.34 260.39
+52 -0.49 -6.47 0.00 0.38 220.52
+53 -2.40 -11.30 0.00 0.26 319.19
+54 -3.84 -11.40 0.29 0.26 217.13
+55 -4.72 -13.35 0.00 0.22 322.80
+56 3.77 -13.94 0.00 0.18 479.35
+57 4.28 -9.70 0.00 0.26 439.03
+58 8.00 -10.93 0.00 0.21 492.09
+59 11.31 -5.17 0.00 0.32 470.39
+60 1.20 -7.16 0.28 0.36 238.18
+61 1.49 -17.55 0.00 0.13 509.16
+62 4.80 -12.69 0.00 0.19 498.46
+63 3.96 -5.71 0.00 0.38 359.98
+64 -1.76 -9.96 0.19 0.29 324.01
+65 0.85 -10.32 0.12 0.26 407.37
+66 1.16 -8.36 0.58 0.33 277.35
+67 -2.02 -10.27 0.88 0.28 255.68
+68 -1.89 -14.65 0.00 0.20 461.08
+69 -4.09 -13.99 0.00 0.21 402.17
+70 2.61 -8.83 0.00 0.29 450.49
+71 3.09 -11.44 0.00 0.22 517.76
+72 -4.28 -11.58 0.00 0.25 338.37
+73 0.36 -15.45 0.00 0.16 548.45
+74 5.66 -9.32 0.00 0.24 537.70
+75 3.95 -4.68 0.00 0.41 393.45
+76 -5.61 -13.72 0.97 0.21 289.64
+77 2.84 -21.70 0.00 0.09 618.91
+78 5.47 -11.21 0.00 0.21 574.09
+79 1.56 -8.19 0.00 0.32 431.33
+80 1.43 -13.38 0.00 0.19 554.01
+81 4.96 -10.45 0.00 0.23 560.44
+82 -3.43 -10.32 0.35 0.28 244.31
+83 -2.51 -14.53 0.00 0.20 499.92
+84 0.03 -15.70 0.00 0.16 573.30
+85 -0.59 -11.09 0.12 0.26 453.12
+86 -4.00 -15.90 0.00 0.18 503.90
+87 -2.18 -13.98 0.63 0.21 380.74
+88 -6.52 -12.29 0.80 0.24 222.23
+89 -3.92 -15.95 0.00 0.18 537.04
+90 1.30 -14.05 0.47 0.21 454.23
+91 -5.25 -9.90 0.76 0.29 191.83
+92 -6.20 -17.85 0.74 0.15 416.37
+93 -4.78 -14.89 0.44 0.19 382.41
+94 -1.89 -17.05 0.00 0.16 633.52
+95 4.71 -11.30 0.00 0.23 643.26
+96 5.55 -9.18 0.00 0.27 619.53
+97 1.75 -10.11 0.00 0.27 553.30
+98 -2.39 -13.20 0.32 0.22 395.94
+99 -0.65 -15.84 0.00 0.17 638.42
+100 4.96 -9.01 0.00 0.27 610.26
+101 0.59 -7.48 0.56 0.35 318.67
+102 -1.99 -8.69 1.15 0.32 275.89
+103 -3.12 -20.97 0.45 0.11 526.79
+104 -1.13 -20.03 0.00 0.12 715.07
+105 5.83 -11.08 0.00 0.22 684.63
+106 7.01 -7.52 0.00 0.29 635.65
+107 3.67 -7.28 0.00 0.33 548.54
+108 9.57 -10.53 0.00 0.21 730.03
+109 11.41 -5.58 0.00 0.30 689.78
+110 12.16 -4.29 0.00 0.32 680.45
+111 12.30 -2.62 0.00 0.38 651.22
+112 12.71 -1.08 0.00 0.43 618.53
+113 10.48 -1.81 0.00 0.43 579.14
+114 4.56 -1.05 2.42 0.57 230.59
+115 -2.92 -5.64 2.62 0.40 127.23
+116 0.25 -13.05 1.33 0.22 479.09
+117 1.56 -10.67 0.70 0.27 458.27
+118 6.14 -9.27 0.00 0.29 685.49
+119 9.08 -6.38 0.00 0.34 682.40
+120 9.69 -2.82 0.00 0.46 606.67
+121 1.71 -3.16 2.01 0.48 207.60
+122 1.97 -7.38 2.43 0.35 381.13
+123 5.11 -6.91 2.10 0.36 462.03
+124 8.67 -4.91 1.62 0.42 496.72
+125 8.89 -3.47 0.00 0.47 630.90
+126 6.97 -1.79 0.98 0.54 370.57
+127 8.40 -2.26 0.29 0.52 431.89
+128 7.01 -1.65 1.00 0.54 370.11
+129 4.44 -1.94 0.79 0.53 290.12
+130 7.68 -2.75 0.00 0.50 585.74
+131 8.40 -2.36 0.00 0.51 595.07
+132 4.42 -2.41 0.36 0.51 309.53
+133 1.01 -8.21 0.44 0.33 411.83
+134 5.89 -8.34 0.20 0.33 726.56
+135 4.51 -6.03 0.63 0.39 463.59
+136 0.67 -3.80 1.02 0.46 229.75
+137 0.97 -5.05 0.66 0.42 306.47
+138 -0.21 -4.98 0.81 0.42 258.21
+139 6.67 -8.87 0.00 0.31 788.15
+140 8.75 -4.38 0.00 0.44 738.41
+141 10.52 1.30 0.00 0.67 601.70
+142 15.82 -0.97 0.00 0.55 792.28
+143 16.81 1.87 0.40 0.70 563.92
+144 13.71 0.56 0.00 0.64 719.11
+145 11.87 -1.48 0.00 0.55 718.78
+146 8.69 -8.14 0.00 0.33 791.58
+147 9.18 -6.26 0.00 0.38 766.24
+148 12.47 -2.00 0.00 0.53 740.22
+149 12.66 -1.28 0.00 0.56 728.08
+150 10.74 -2.68 0.00 0.50 717.71
+151 12.57 -2.84 0.00 0.49 751.03
+152 14.94 -2.30 0.00 0.50 774.35
+153 11.77 -3.90 0.00 0.46 749.83
+154 12.61 -1.87 0.00 0.53 720.47
+155 16.23 1.22 0.00 0.65 721.77
+156 16.56 0.53 0.00 0.62 736.33
+157 16.32 3.33 0.00 0.78 655.81
+158 15.56 1.96 0.00 0.70 670.49
+159 12.75 -2.12 0.00 0.52 702.55
+160 15.04 1.20 0.00 0.66 666.23
+161 14.49 -0.25 0.00 0.59 687.65
+162 15.13 1.71 0.00 0.69 642.20
+163 18.71 2.91 0.00 0.72 690.37
+164 18.03 2.31 0.00 0.70 687.31
+165 18.27 3.64 0.00 0.78 654.04
+166 17.41 1.27 0.00 0.65 684.75
+167 15.04 -1.97 0.00 0.51 700.41
+168 14.68 -0.67 0.00 0.58 652.98
+169 18.07 0.97 0.00 0.63 685.36
+170 18.59 3.88 0.00 0.79 621.57
+171 16.75 3.51 0.00 0.79 577.21
+172 17.92 1.90 0.00 0.68 651.99
+173 16.49 2.94 0.00 0.75 586.24
+174 18.57 2.53 0.00 0.71 646.51
+175 22.55 3.98 0.00 0.76 685.87
+176 22.38 7.78 0.00 1.03 591.24
+177 22.05 5.77 0.00 0.88 633.79
+178 21.73 6.18 0.00 0.91 613.69
+179 19.12 7.58 0.00 1.04 496.67
+180 18.93 3.56 0.00 0.76 611.46
+181 21.24 5.36 0.00 0.85 616.26
+182 20.76 8.44 0.00 1.10 514.91
+183 18.36 6.05 0.87 0.94 389.32
+184 16.97 5.75 0.77 0.92 364.40
+185 18.07 3.13 0.00 0.74 598.98
+186 21.19 4.94 0.00 0.82 621.13
+187 21.81 5.27 0.00 0.84 621.26
+188 22.81 5.65 0.00 0.85 627.05
+189 20.40 6.51 0.39 0.97 410.21
+190 18.40 4.23 0.63 0.83 418.25
+191 21.28 5.28 0.00 0.86 597.42
+192 21.67 7.12 0.47 1.01 414.44
+193 17.90 6.66 1.08 0.98 348.09
+194 19.84 4.96 0.61 0.87 423.39
+195 17.63 4.56 0.73 0.85 390.26
+196 18.77 2.69 0.00 0.74 595.79
+197 19.79 4.22 0.00 0.82 580.58
+198 22.41 4.27 0.00 0.80 622.41
+199 20.86 6.23 0.00 0.95 549.69
+200 19.98 5.01 0.00 0.87 557.98
+201 20.82 7.28 0.00 1.02 515.35
+202 19.35 5.33 0.00 0.89 531.24
+203 20.36 4.76 0.00 0.86 563.05
+204 22.31 5.71 0.00 0.91 576.17
+205 19.82 5.42 0.24 0.90 397.92
+206 19.05 5.71 0.00 0.92 457.72
+207 18.42 2.39 0.62 0.73 385.27
+208 17.76 3.04 0.00 0.75 491.58
+209 20.06 4.93 0.00 0.84 493.05
+210 22.13 5.79 0.00 0.88 511.41
+211 22.43 7.31 0.00 0.99 486.22
+212 19.63 8.46 0.23 1.11 293.89
+213 21.18 5.79 0.27 0.92 366.67
+214 20.12 6.80 0.00 0.88 448.95
+215 20.00 5.83 0.00 0.77 470.62
+216 20.35 6.15 0.00 0.78 471.38
+217 19.01 2.83 0.00 0.58 514.60
+218 21.17 5.84 0.00 0.71 495.04
+219 23.51 7.63 0.00 0.74 500.71
+220 23.74 7.14 0.00 0.67 512.47
+221 20.62 6.64 0.87 0.85 343.69
+222 22.82 6.98 0.97 0.86 367.61
+223 22.14 7.01 0.00 0.77 479.91
+224 22.33 7.52 0.00 0.79 471.72
+225 22.32 6.87 0.00 0.74 482.80
+226 19.25 6.08 0.00 0.74 438.56
+227 17.68 6.87 1.07 0.93 281.40
+228 15.28 7.61 0.95 1.04 212.49
+229 14.62 4.29 0.00 0.72 376.02
+230 16.61 1.72 0.00 0.51 487.44
+231 17.03 3.82 0.00 0.62 449.42
+232 18.37 5.72 0.00 0.72 432.68
+233 14.77 0.92 0.00 0.51 465.47
+234 19.63 -0.83 0.00 0.37 556.54
+235 21.32 4.24 0.00 0.56 510.40
+236 17.24 7.23 0.00 0.88 355.19
+237 15.22 3.28 0.80 0.72 307.97
+238 13.70 3.32 0.77 0.77 277.80
+239 14.13 1.82 0.77 0.69 316.47
+240 16.38 2.53 0.00 0.63 456.81
+241 18.42 4.57 0.00 0.72 452.46
+242 17.38 4.16 0.00 0.71 437.26
+243 13.34 1.66 0.00 0.64 406.54
+244 14.64 0.10 0.00 0.53 466.12
+245 14.24 -1.12 0.00 0.49 478.22
+246 18.26 2.03 0.00 0.59 483.90
+247 18.46 4.49 0.00 0.73 442.57
+248 19.18 3.21 0.00 0.64 474.89
+249 19.29 3.98 0.00 0.69 461.57
+250 19.86 3.78 0.00 0.67 471.07
+251 16.78 3.43 0.00 0.70 424.25
+252 15.05 3.42 1.32 0.78 289.84
+253 6.76 2.47 0.60 0.73 126.47
+254 14.36 3.04 0.26 0.76 288.79
+255 13.04 0.20 0.00 0.61 421.13
+256 13.49 2.38 0.00 0.72 379.45
+257 15.05 2.78 0.00 0.74 401.45
+258 18.41 2.83 0.00 0.70 450.62
+259 17.05 2.52 0.00 0.70 431.11
+260 12.64 2.93 0.36 0.75 248.57
+261 15.13 2.63 0.00 0.74 392.98
+262 19.83 1.10 0.00 0.61 473.45
+263 19.62 7.49 0.47 1.04 278.29
+264 15.89 1.31 0.00 0.67 423.09
+265 15.17 1.21 0.00 0.67 413.10
+266 11.38 -1.62 0.00 0.54 396.65
+267 12.60 -3.04 0.00 0.49 432.71
+268 11.80 -3.34 0.00 0.48 421.70
+269 13.11 -3.04 0.00 0.49 429.46
+270 16.83 -1.66 0.00 0.53 446.31
+271 16.30 0.65 0.00 0.64 409.50
+272 16.71 0.96 0.00 0.65 406.54
+273 15.83 1.51 0.00 0.68 382.61
+274 18.56 1.11 0.00 0.65 416.99
+275 16.49 2.66 0.00 0.74 367.05
+276 12.20 -2.92 0.00 0.49 390.28
+277 14.10 -0.80 0.00 0.58 381.56
+278 15.18 -0.19 0.00 0.60 383.60
+279 13.73 -0.60 0.00 0.58 368.05
+280 17.52 -0.99 0.00 0.56 409.36
+281 17.94 0.52 0.00 0.62 393.94
+282 17.08 0.90 0.00 0.65 375.38
+283 15.34 0.63 0.00 0.64 350.85
+284 11.26 -2.62 0.00 0.50 339.10
+285 14.19 -2.56 0.00 0.49 370.84
+286 11.27 0.23 0.00 0.62 281.57
+287 8.30 -1.61 0.00 0.54 259.41
+288 11.31 -2.02 0.00 0.53 319.55
+289 6.25 -2.89 0.19 0.49 243.09
+290 -1.97 -9.27 0.00 0.30 202.67
+291 0.17 -7.87 0.00 0.34 219.84
+292 0.78 -9.09 0.00 0.31 262.18
+293 7.43 -7.75 0.00 0.34 340.51
+294 9.51 -8.62 0.00 0.32 364.11
+295 8.59 -8.46 0.00 0.32 351.31
+296 5.30 -6.26 0.00 0.38 278.96
+297 -2.82 -14.22 0.00 0.20 279.06
+298 3.79 -14.50 0.00 0.20 355.11
+299 10.12 -9.03 0.00 0.31 354.00
+300 2.43 -5.85 0.52 0.39 159.43
+301 -3.67 -10.65 0.35 0.27 155.57
+302 -3.75 -16.77 0.00 0.16 331.27
+303 3.81 -15.30 0.00 0.19 387.24
+304 9.81 -7.24 0.00 0.35 364.26
+305 9.68 -5.70 0.00 0.40 343.04
+306 12.20 -4.41 0.00 0.44 350.22
+307 8.47 -3.01 0.00 0.49 283.44
+308 7.09 -5.31 0.00 0.41 298.20
+309 6.36 -4.80 0.00 0.43 276.62
+310 11.36 -4.86 0.00 0.43 337.71
+311 10.32 -2.52 0.00 0.51 268.04
+312 10.51 0.30 0.00 0.62 229.34
+313 8.80 -1.15 0.00 0.56 226.22
+314 12.11 -1.45 0.00 0.55 271.85
+315 14.45 -3.18 0.00 0.47 302.27
+316 12.56 -2.26 0.00 0.52 278.41
+317 8.74 -2.54 0.42 0.51 180.06
+318 0.43 -8.48 0.41 0.32 171.58
+319 -7.58 -15.00 0.22 0.19 148.95
+320 -6.57 -21.93 0.00 0.11 313.12
+321 -10.52 -21.39 0.07 0.11 255.14
+322 -0.58 -20.91 0.00 0.12 335.56
+323 0.74 -15.79 0.00 0.18 309.74
+324 -0.33 -15.88 0.00 0.18 299.73
+325 1.92 -15.28 0.00 0.19 309.70
+326 3.66 -12.94 0.00 0.23 301.17
+327 -2.50 -13.69 0.00 0.21 241.66
+328 -2.79 -11.32 0.00 0.26 199.07
+329 -8.55 -13.50 0.36 0.22 97.12
+330 -2.62 -20.14 0.00 0.12 305.21
+331 -5.47 -16.64 0.00 0.17 240.04
+332 -0.86 -18.92 0.00 0.14 302.05
+333 1.06 -14.53 0.00 0.20 283.49
+334 5.19 -6.51 0.00 0.37 240.64
+335 4.62 -3.36 0.00 0.48 182.04
+336 1.05 -7.53 0.00 0.35 196.75
+337 8.05 -13.60 0.00 0.19 307.81
+338 6.35 -5.64 0.00 0.40 240.04
+339 5.93 -1.56 0.00 0.54 168.63
+340 0.87 -7.73 0.00 0.34 193.47
+341 -0.86 -9.77 0.00 0.29 200.14
+342 -2.61 -11.04 0.29 0.26 146.72
+343 -2.71 -16.66 0.28 0.17 202.77
+344 -5.32 -16.86 0.00 0.16 239.19
+345 0.42 -14.02 0.00 0.19 268.55
+346 3.58 -7.64 0.00 0.31 233.65
+347 6.91 -8.15 0.00 0.27 269.93
+348 4.95 -9.79 0.00 0.24 265.91
+349 5.01 -9.83 0.00 0.24 264.25
+350 5.73 -7.08 0.00 0.31 244.60
+351 6.57 -6.35 0.00 0.31 244.86
+352 8.86 -4.29 0.00 0.34 248.36
+353 4.91 -8.70 0.00 0.26 255.05
+354 1.25 -9.82 0.00 0.24 229.19
+355 5.08 -9.78 0.00 0.21 267.97
+356 0.44 -9.63 0.00 0.26 218.92
+357 1.56 -7.74 0.00 0.30 207.35
+358 -2.10 -10.18 0.00 0.27 187.68
+359 2.31 -10.79 0.00 0.21 254.05
+360 5.37 -5.93 0.00 0.30 235.22
+361 4.40 -5.17 0.00 0.34 211.93
+362 10.81 -4.53 0.00 0.28 275.20
+363 6.39 -5.22 0.00 0.31 243.28
+364 6.81 -10.64 0.00 0.18 289.69
+365 8.94 -8.32 0.00 0.21 287.19
+366 8.94 -8.32 0.00 0.21 287.19
diff --git a/inst/extdata/example1/Input/data_weather_daymet/weath.1981 b/inst/extdata/example1/Input/data_weather_daymet/weath.1981
new file mode 100644
index 00000000..e06ee2ff
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_daymet/weath.1981
@@ -0,0 +1,367 @@
+# weather for site daymet example at -105.58 / 39.59 year = 1981
+# DOY, Tmax_C, Tmin_C, PPT_cm, vp_kPa, rsds_WPERm2
+1 5.81 -9.20 0.00 0.30 278.89
+2 1.59 -7.56 0.00 0.35 206.71
+3 3.08 -9.22 0.00 0.30 253.62
+4 1.88 -8.46 0.00 0.32 228.01
+5 -2.21 -10.00 0.13 0.29 185.62
+6 -0.11 -15.82 0.00 0.18 292.82
+7 5.26 -11.83 0.00 0.25 301.90
+8 4.33 -10.60 0.00 0.27 287.50
+9 3.09 -11.15 0.00 0.26 283.59
+10 1.49 -11.71 0.00 0.25 274.66
+11 1.30 -13.99 0.00 0.21 297.40
+12 4.83 -12.22 0.00 0.24 311.02
+13 2.62 -11.34 0.00 0.26 287.56
+14 0.69 -12.67 0.00 0.23 283.54
+15 -1.29 -13.72 0.00 0.21 274.71
+16 -4.58 -14.17 0.07 0.20 233.90
+17 1.12 -14.41 0.00 0.20 312.07
+18 -1.21 -12.53 0.00 0.23 264.96
+19 -2.53 -16.64 0.00 0.17 303.68
+20 -2.82 -14.06 0.00 0.21 268.07
+21 5.06 -14.92 0.00 0.19 348.38
+22 7.86 -10.78 0.00 0.27 343.57
+23 7.27 -8.10 0.00 0.33 321.96
+24 3.28 -9.00 0.00 0.31 290.18
+25 -6.18 -15.43 0.00 0.18 243.79
+26 -7.86 -17.79 0.00 0.15 259.69
+27 -2.46 -13.96 0.00 0.21 288.21
+28 1.10 -10.55 0.00 0.27 291.45
+29 0.24 -10.82 0.00 0.27 284.56
+30 -0.12 -11.20 0.00 0.26 287.31
+31 -11.37 -16.09 0.13 0.17 147.91
+32 -12.45 -18.35 0.03 0.14 183.89
+33 -5.96 -16.95 0.00 0.16 303.04
+34 -1.57 -16.96 0.00 0.16 362.88
+35 -1.51 -15.79 0.00 0.18 351.38
+36 -2.22 -14.65 0.00 0.20 331.13
+37 -5.59 -13.98 0.00 0.21 257.99
+38 -5.69 -14.89 0.00 0.19 282.54
+39 -5.46 -14.31 0.00 0.20 279.65
+40 -2.54 -13.96 0.76 0.21 257.04
+41 -7.93 -26.00 0.47 0.07 320.74
+42 0.00 -29.69 0.00 0.05 452.77
+43 -2.63 -10.25 0.00 0.28 254.73
+44 3.53 -8.57 0.00 0.32 357.60
+45 7.13 -7.34 0.00 0.33 394.24
+46 3.20 -7.91 0.00 0.34 343.19
+47 7.50 -8.28 0.00 0.30 416.27
+48 3.19 -5.87 0.00 0.39 303.11
+49 3.34 -8.68 0.00 0.31 373.45
+50 6.92 -5.68 0.00 0.37 384.48
+51 3.75 -5.25 0.00 0.41 315.69
+52 -5.77 -16.64 0.00 0.17 374.94
+53 -1.92 -16.22 0.00 0.17 437.01
+54 4.87 -9.90 0.00 0.26 442.57
+55 5.61 -7.74 0.00 0.30 423.41
+56 5.84 -9.16 0.00 0.26 449.42
+57 0.98 -9.57 0.00 0.29 374.60
+58 2.18 -11.65 0.00 0.23 441.17
+59 2.80 -12.19 0.00 0.21 459.97
+60 0.15 -11.29 0.25 0.26 303.72
+61 1.20 -10.54 0.18 0.26 407.94
+62 -4.52 -8.55 1.07 0.32 128.90
+63 -2.71 -11.97 0.48 0.24 270.80
+64 3.64 -15.40 0.00 0.17 526.38
+65 0.83 -11.19 0.63 0.26 329.09
+66 -4.81 -11.91 0.42 0.25 226.53
+67 -0.32 -14.40 0.00 0.20 486.32
+68 -0.64 -16.42 0.00 0.17 512.72
+69 0.67 -14.66 0.00 0.19 506.16
+70 -0.73 -14.73 0.00 0.19 486.33
+71 0.90 -13.03 0.46 0.22 371.21
+72 -0.49 -13.40 0.42 0.22 368.35
+73 3.19 -12.22 0.00 0.22 530.55
+74 2.64 -13.83 0.00 0.19 547.48
+75 5.29 -12.01 0.00 0.21 559.92
+76 -2.22 -10.38 0.00 0.28 355.73
+77 -2.25 -13.22 0.00 0.22 453.17
+78 5.04 -13.50 0.00 0.18 585.41
+79 3.72 -7.15 0.37 0.36 336.38
+80 -2.68 -9.27 0.56 0.30 230.68
+81 1.86 -14.92 0.00 0.16 581.04
+82 2.50 -9.37 0.00 0.26 486.75
+83 -0.76 -8.88 0.99 0.31 281.13
+84 5.37 -15.43 0.00 0.14 635.84
+85 8.35 -9.23 0.00 0.22 604.73
+86 1.12 -5.03 0.00 0.42 295.62
+87 -6.54 -11.07 1.46 0.26 175.19
+88 0.55 -11.68 0.00 0.22 533.24
+89 1.27 -10.06 0.00 0.25 513.50
+90 -0.70 -14.86 0.00 0.16 587.68
+91 8.84 -11.07 0.00 0.16 663.36
+92 7.44 -2.68 0.34 0.45 345.89
+93 -3.41 -7.27 0.00 0.35 204.34
+94 -5.04 -14.68 0.00 0.19 470.38
+95 5.09 -14.14 0.00 0.13 672.43
+96 5.96 -8.14 0.00 0.23 590.47
+97 4.21 -8.66 0.72 0.27 424.78
+98 2.37 -8.30 0.00 0.27 507.84
+99 9.98 -8.33 0.00 0.20 674.34
+100 12.50 -1.24 0.00 0.36 592.24
+101 10.14 -2.47 0.00 0.35 568.31
+102 9.01 -3.54 0.00 0.32 569.35
+103 9.69 -4.58 0.00 0.28 616.40
+104 8.68 -5.63 0.00 0.26 621.67
+105 10.15 -1.97 0.00 0.35 569.27
+106 9.53 -3.75 0.00 0.30 599.78
+107 13.28 -2.73 0.00 0.28 655.36
+108 10.54 -1.78 0.00 0.35 575.54
+109 6.22 -2.96 0.78 0.45 350.56
+110 9.12 -5.79 0.35 0.32 477.82
+111 8.86 -2.53 0.00 0.38 550.35
+112 4.19 -6.60 0.00 0.30 535.86
+113 10.23 -7.42 0.00 0.22 693.57
+114 12.99 -3.11 0.00 0.29 670.14
+115 16.12 -0.73 0.00 0.33 681.58
+116 16.54 -0.14 0.00 0.34 672.13
+117 13.75 0.06 0.00 0.39 602.83
+118 13.01 -1.81 0.00 0.33 631.00
+119 13.96 -1.92 0.00 0.32 650.76
+120 14.06 0.49 0.00 0.41 595.16
+121 15.64 -0.31 0.00 0.34 654.39
+122 12.95 2.16 1.02 0.61 378.34
+123 9.42 0.47 0.34 0.61 323.40
+124 7.38 -4.62 0.48 0.40 410.12
+125 11.14 -4.73 1.13 0.36 486.66
+126 7.85 -2.81 0.49 0.49 379.11
+127 5.84 -6.04 0.00 0.34 556.72
+128 1.16 -6.91 0.54 0.36 309.78
+129 0.24 -8.65 0.58 0.32 345.76
+130 8.21 -9.24 0.00 0.24 704.26
+131 8.94 -5.24 0.00 0.33 635.39
+132 5.46 -5.51 0.55 0.40 403.01
+133 5.19 -9.66 0.00 0.24 658.46
+134 12.16 -6.51 0.00 0.26 721.33
+135 8.88 -3.17 0.00 0.40 572.65
+136 1.61 -2.70 0.00 0.50 240.24
+137 3.25 -3.14 2.25 0.48 263.25
+138 2.40 -3.30 0.60 0.48 240.89
+139 10.64 -4.10 0.00 0.37 663.89
+140 10.60 -1.99 0.00 0.46 607.36
+141 7.57 -1.15 0.00 0.55 465.19
+142 7.55 -1.55 0.00 0.53 483.81
+143 7.19 -1.20 0.00 0.55 460.40
+144 11.63 -3.71 0.66 0.43 510.78
+145 11.66 -1.22 0.00 0.48 629.99
+146 13.77 -1.08 0.00 0.45 677.98
+147 14.56 1.62 0.00 0.57 628.12
+148 12.59 1.39 1.17 0.67 428.65
+149 7.41 0.04 0.30 0.61 318.67
+150 13.89 -0.75 1.06 0.55 501.99
+151 12.86 2.18 0.31 0.71 420.96
+152 13.44 -1.99 0.00 0.45 692.88
+153 15.45 0.59 0.90 0.60 498.63
+154 12.29 0.66 1.04 0.64 437.71
+155 11.73 0.92 0.00 0.61 565.36
+156 14.29 0.84 0.00 0.56 640.20
+157 18.19 2.44 0.00 0.58 679.74
+158 18.66 2.74 0.00 0.60 675.18
+159 19.60 7.85 0.00 0.92 560.27
+160 20.75 10.99 0.00 1.20 486.95
+161 19.86 6.06 0.00 0.78 621.25
+162 20.93 5.13 0.00 0.69 657.72
+163 20.48 6.26 0.00 0.76 623.30
+164 16.60 7.34 0.00 0.95 475.75
+165 9.00 -1.75 0.00 0.50 547.82
+166 7.87 -5.71 0.00 0.36 627.17
+167 17.18 -2.42 0.00 0.40 707.54
+168 18.29 5.42 0.00 0.76 571.62
+169 15.89 -0.42 0.00 0.48 654.41
+170 20.32 3.87 0.00 0.63 645.07
+171 20.17 4.73 0.00 0.67 618.87
+172 21.59 4.06 0.00 0.62 648.25
+173 22.95 5.23 0.00 0.67 640.73
+174 21.49 7.80 0.00 0.84 555.31
+175 20.88 6.53 0.00 0.77 570.35
+176 23.05 7.23 0.00 0.77 596.36
+177 22.71 7.96 0.38 1.01 377.59
+178 20.14 6.15 0.29 0.89 368.56
+179 15.36 4.24 0.44 0.83 315.90
+180 16.43 2.57 1.11 0.72 369.52
+181 18.32 3.40 0.00 0.68 515.88
+182 18.42 4.57 0.46 0.84 364.69
+183 11.77 7.85 1.10 1.06 126.47
+184 14.74 5.16 0.80 0.88 285.46
+185 15.47 4.32 0.00 0.82 431.36
+186 19.46 3.84 0.00 0.72 533.40
+187 22.86 7.94 0.00 0.95 512.21
+188 22.00 9.05 0.29 1.15 347.67
+189 14.76 5.82 0.62 0.92 270.35
+190 18.63 6.64 0.53 0.98 335.25
+191 19.37 6.79 0.00 0.94 465.73
+192 20.84 7.27 0.55 1.02 362.76
+193 18.52 6.75 0.46 0.98 333.30
+194 15.71 6.11 0.50 0.94 287.31
+195 19.29 7.39 0.38 1.03 333.63
+196 19.68 6.85 0.28 0.99 351.28
+197 14.93 6.94 0.51 1.00 250.73
+198 17.01 8.00 0.50 1.07 277.47
+199 16.46 3.84 0.29 0.80 362.08
+200 19.88 4.02 0.00 0.77 547.55
+201 22.02 4.89 0.00 0.80 561.20
+202 21.90 7.89 0.00 1.02 506.28
+203 21.24 7.03 0.00 0.96 514.14
+204 22.14 8.15 0.00 1.04 506.55
+205 18.34 5.50 0.27 0.90 364.72
+206 18.17 4.65 0.36 0.85 377.73
+207 15.38 5.18 0.90 0.88 317.45
+208 15.00 3.19 0.00 0.77 474.56
+209 19.51 2.91 0.00 0.73 558.61
+210 20.37 7.01 0.00 1.00 495.71
+211 20.89 8.13 0.00 1.08 481.01
+212 21.52 6.83 0.00 0.97 520.34
+213 18.42 8.24 0.00 1.09 408.61
+214 21.29 5.27 0.00 0.85 536.12
+215 21.25 5.81 0.00 0.88 522.96
+216 22.07 8.12 0.00 1.03 492.15
+217 22.69 6.85 0.00 0.91 526.54
+218 18.08 7.12 0.00 1.01 424.07
+219 15.88 3.82 0.00 0.80 456.01
+220 17.69 3.59 0.00 0.75 499.03
+221 8.51 3.41 0.43 0.78 168.10
+222 9.20 2.80 0.45 0.75 210.48
+223 12.21 2.68 0.53 0.74 295.33
+224 11.21 5.72 0.63 0.92 182.48
+225 13.76 2.91 0.44 0.75 325.50
+226 14.73 2.64 0.70 0.74 348.81
+227 14.03 5.50 0.95 0.90 267.66
+228 13.67 2.95 0.58 0.75 319.62
+229 15.75 2.07 0.00 0.71 494.49
+230 17.94 2.18 0.00 0.69 526.75
+231 19.31 3.47 0.00 0.75 524.67
+232 19.14 5.06 0.17 0.86 492.10
+233 20.14 5.44 0.40 0.90 373.26
+234 13.42 4.42 0.19 0.84 370.34
+235 17.03 2.44 0.00 0.72 502.81
+236 16.68 5.12 0.00 0.88 437.76
+237 18.12 3.32 0.00 0.77 498.96
+238 17.73 3.78 0.00 0.80 481.15
+239 16.70 2.73 0.00 0.74 483.74
+240 18.46 3.16 0.00 0.74 501.27
+241 18.16 4.59 0.00 0.82 468.11
+242 18.35 3.94 0.00 0.77 482.16
+243 14.30 4.12 0.27 0.82 291.55
+244 16.27 1.09 0.55 0.66 370.53
+245 19.28 4.34 0.00 0.78 484.62
+246 14.30 2.52 0.00 0.73 428.35
+247 16.61 5.06 0.00 0.87 419.96
+248 16.00 4.12 0.47 0.82 319.71
+249 12.00 2.85 0.00 0.75 358.57
+250 7.49 2.53 0.00 0.73 215.03
+251 12.89 1.92 0.48 0.70 305.77
+252 14.56 2.42 0.72 0.73 319.93
+253 13.33 1.49 0.29 0.68 313.79
+254 12.45 3.00 0.00 0.76 352.35
+255 13.91 2.20 0.00 0.72 407.01
+256 15.63 0.97 0.00 0.66 456.83
+257 15.79 2.59 0.21 0.74 320.19
+258 14.64 1.31 0.00 0.67 426.69
+259 10.86 2.09 0.00 0.71 320.94
+260 14.17 -0.81 0.00 0.58 452.56
+261 17.55 0.64 0.00 0.64 469.11
+262 17.21 1.50 0.00 0.68 451.55
+263 15.66 3.39 0.00 0.78 394.83
+264 16.06 3.11 0.00 0.76 402.57
+265 15.70 2.72 0.00 0.74 402.19
+266 16.44 2.83 0.12 0.75 408.72
+267 14.17 3.44 0.00 0.78 352.44
+268 14.52 2.33 0.00 0.72 382.82
+269 11.40 0.19 0.00 0.62 365.42
+270 17.02 -0.61 0.00 0.58 450.94
+271 17.52 3.82 0.00 0.80 396.99
+272 15.67 4.82 0.00 0.86 344.46
+273 12.66 3.06 0.00 0.76 316.60
+274 15.63 -0.28 0.00 0.60 423.44
+275 13.45 1.56 0.00 0.68 363.27
+276 6.40 1.99 0.00 0.70 163.27
+277 8.11 -1.33 0.00 0.55 315.44
+278 8.06 -2.91 0.00 0.49 347.99
+279 11.78 -3.84 0.00 0.46 410.80
+280 13.62 -0.22 0.00 0.60 379.00
+281 10.26 1.71 0.00 0.69 274.10
+282 6.33 -0.90 0.00 0.57 241.56
+283 11.02 -2.20 0.00 0.52 366.21
+284 12.32 1.29 0.00 0.67 322.74
+285 6.22 -1.70 0.00 0.54 255.42
+286 7.49 -1.82 0.34 0.53 219.08
+287 4.05 -1.40 0.56 0.55 141.20
+288 0.08 -2.01 1.20 0.53 64.36
+289 1.84 -4.04 0.00 0.45 205.44
+290 2.27 -6.88 0.00 0.36 295.45
+291 6.41 -8.75 0.00 0.32 382.65
+292 9.48 -7.53 0.00 0.35 390.48
+293 8.17 -5.58 0.00 0.40 358.88
+294 3.36 -6.76 0.00 0.37 305.80
+295 2.25 -6.11 0.00 0.39 268.35
+296 5.94 -8.29 0.00 0.33 358.93
+297 -1.16 -5.27 0.58 0.41 110.19
+298 0.09 -13.73 0.00 0.21 353.16
+299 10.49 -10.97 0.00 0.26 382.87
+300 11.09 -5.46 0.00 0.41 359.00
+301 9.75 -2.10 0.00 0.52 310.47
+302 7.66 -2.15 0.00 0.52 276.88
+303 -1.17 -9.43 1.09 0.30 210.85
+304 -2.36 -12.06 0.00 0.24 312.77
+305 4.31 -13.24 0.00 0.22 394.40
+306 6.11 -8.24 0.00 0.33 363.34
+307 6.76 -7.26 0.00 0.35 354.56
+308 9.66 -6.88 0.00 0.36 369.73
+309 6.40 -7.90 0.00 0.34 349.22
+310 8.47 -3.80 0.00 0.46 320.97
+311 5.37 -5.29 0.00 0.41 294.03
+312 1.24 -6.69 0.42 0.37 180.70
+313 2.92 -11.01 0.00 0.26 335.69
+314 6.11 -10.20 0.00 0.28 349.18
+315 6.97 -8.88 0.00 0.31 340.06
+316 7.16 -8.77 0.00 0.31 335.90
+317 8.81 -8.48 0.00 0.32 338.67
+318 8.40 -2.42 0.00 0.51 260.00
+319 8.79 -4.61 0.00 0.43 291.12
+320 10.07 -0.55 0.00 0.59 246.65
+321 10.87 -2.37 0.00 0.51 282.00
+322 -3.79 -9.38 0.00 0.30 151.55
+323 -2.40 -13.24 0.00 0.22 257.83
+324 2.58 -12.89 0.00 0.23 305.82
+325 3.25 -6.36 0.00 0.38 228.39
+326 3.09 -6.43 0.00 0.38 227.05
+327 3.99 -8.80 0.00 0.31 269.89
+328 9.01 -3.54 0.00 0.47 262.51
+329 4.39 -4.86 0.44 0.43 166.34
+330 -5.11 -16.21 0.00 0.17 252.33
+331 -0.15 -13.65 0.00 0.21 277.55
+332 -0.73 -15.76 0.00 0.18 288.37
+333 -2.64 -11.39 0.39 0.26 157.53
+334 -10.54 -15.54 0.00 0.18 130.99
+335 -7.61 -18.47 0.00 0.14 244.44
+336 -3.29 -14.86 0.00 0.19 252.78
+337 -1.42 -7.62 0.00 0.34 159.16
+338 5.04 -10.96 0.00 0.26 289.66
+339 3.42 -7.17 0.00 0.36 237.39
+340 5.66 -4.66 0.00 0.43 232.06
+341 7.81 -5.96 0.00 0.39 268.54
+342 8.01 -6.29 0.00 0.38 270.10
+343 9.24 -7.90 0.00 0.31 287.28
+344 4.70 -4.50 0.00 0.44 209.68
+345 4.30 -7.34 0.27 0.35 188.09
+346 -0.19 -9.60 0.00 0.30 218.77
+347 -1.10 -11.03 0.16 0.26 229.68
+348 -2.53 -10.62 0.00 0.27 200.11
+349 -0.28 -7.12 0.64 0.36 135.16
+350 -7.79 -13.47 0.51 0.22 118.68
+351 -8.25 -17.02 0.00 0.16 221.18
+352 -0.51 -14.70 0.00 0.20 278.60
+353 1.71 -8.25 0.00 0.33 233.07
+354 2.01 -5.83 0.50 0.40 152.75
+355 -5.49 -8.51 0.69 0.32 69.31
+356 -10.30 -14.80 0.59 0.19 101.61
+357 -14.37 -22.71 0.00 0.10 223.36
+358 -7.76 -23.50 0.00 0.09 297.45
+359 -10.09 -14.99 0.39 0.19 111.77
+360 -10.33 -21.03 0.73 0.11 200.76
+361 -12.47 -17.67 0.61 0.15 122.25
+362 -11.77 -21.53 0.00 0.11 257.72
+363 -2.98 -20.20 0.00 0.12 311.08
+364 -1.81 -12.51 0.82 0.23 202.83
+365 -2.95 -14.10 0.69 0.21 209.22
diff --git a/inst/extdata/example1/Input/data_weather_gridmet/weath.1980 b/inst/extdata/example1/Input/data_weather_gridmet/weath.1980
new file mode 100644
index 00000000..df390099
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_gridmet/weath.1980
@@ -0,0 +1,368 @@
+# weather for site gridmet example at -105.58 / 39.59 year = 1980
+# DOY, Tmax_C, Tmin_C, PPT_cm, sfcWind_mPERs, hursmax_pct, hursmin_pct, rsds_WPERm2
+1 -3.18 -12.32 0.75 3.16 74.17 31.42 93.43
+2 -7.47 -17.53 0.16 3.08 100.00 45.43 62.40
+3 -5.49 -19.73 0.09 5.08 83.53 38.31 97.25
+4 -4.09 -14.61 0.00 4.83 76.36 48.42 98.57
+5 -0.49 -12.20 0.00 5.93 75.18 37.81 99.56
+6 -4.01 -15.73 0.66 8.55 63.22 28.94 101.83
+7 -8.99 -18.31 0.29 4.77 94.24 48.81 83.69
+8 -6.56 -18.60 0.55 6.18 83.57 50.66 84.40
+9 -3.28 -14.32 0.19 5.05 75.06 53.04 101.27
+10 -2.58 -11.95 0.49 10.07 88.49 51.53 94.01
+11 -7.69 -19.43 0.07 5.44 79.21 33.63 102.55
+12 -0.66 -11.63 0.39 7.90 91.83 55.05 94.64
+13 -0.34 -6.65 0.09 5.76 84.86 53.88 102.87
+14 1.84 -7.11 0.00 4.16 84.82 49.71 101.95
+15 -1.47 -9.66 0.00 3.19 88.35 34.35 104.86
+16 -3.63 -12.83 0.00 2.49 86.95 37.00 91.15
+17 -3.64 -14.38 0.60 3.09 95.44 43.91 100.81
+18 -5.05 -14.03 0.96 3.79 98.84 47.13 89.72
+19 -10.02 -18.38 0.24 2.96 100.00 60.81 99.18
+20 -4.19 -16.38 0.04 2.97 91.31 42.67 114.47
+21 -4.76 -15.25 0.05 2.89 77.27 42.25 103.52
+22 -8.50 -22.42 0.00 4.27 89.88 34.86 119.05
+23 -3.60 -17.24 0.00 5.18 60.97 33.60 116.35
+24 -0.78 -11.33 0.08 6.76 63.83 39.22 117.15
+25 -4.70 -15.67 0.77 4.15 84.19 37.65 106.71
+26 -8.91 -20.27 0.40 3.00 99.57 47.62 106.83
+27 -4.93 -16.87 0.18 5.32 76.73 53.29 112.25
+28 -6.23 -14.42 0.51 2.80 98.13 51.16 101.26
+29 -4.05 -14.35 0.54 5.47 98.82 62.55 108.96
+30 -8.08 -18.67 0.02 3.90 89.93 46.95 127.95
+31 -3.79 -18.50 0.00 3.37 68.57 26.31 128.77
+32 -2.49 -12.90 0.00 5.06 62.46 24.41 130.80
+33 -2.37 -12.73 0.00 5.36 96.58 44.84 131.59
+34 2.40 -9.98 0.00 4.75 89.05 32.52 128.80
+35 -1.27 -10.03 0.00 5.71 86.31 33.75 130.29
+36 -0.61 -12.21 0.00 4.40 65.03 23.50 138.31
+37 1.91 -8.59 0.00 3.43 52.21 13.37 126.21
+38 -4.52 -18.49 1.88 6.56 100.00 36.54 118.06
+39 -10.17 -23.67 0.15 2.47 100.00 55.46 145.41
+40 -3.49 -20.98 0.00 3.79 89.15 9.98 146.30
+41 -2.89 -15.48 0.00 4.14 63.68 25.16 147.20
+42 -5.12 -17.45 0.00 2.74 72.97 26.97 145.36
+43 -3.78 -16.58 0.00 4.67 85.32 51.28 148.48
+44 -1.75 -13.73 0.00 4.85 80.28 50.62 148.80
+45 0.05 -11.08 0.37 3.82 86.85 49.06 142.58
+46 -1.45 -10.11 0.35 2.23 100.00 59.03 117.92
+47 -2.31 -10.87 0.08 2.85 100.00 60.20 143.15
+48 -1.16 -12.21 0.08 4.26 99.00 63.65 144.30
+49 2.20 -7.80 0.38 5.34 96.32 58.82 124.41
+50 -1.14 -9.63 0.32 4.85 100.00 54.18 144.18
+51 -1.44 -10.05 0.03 5.55 96.60 56.92 133.29
+52 -2.33 -11.37 0.13 4.96 95.97 52.45 161.09
+53 -3.14 -13.66 0.03 3.89 97.29 51.53 145.03
+54 -4.55 -14.93 0.36 3.36 99.36 47.35 153.70
+55 -6.17 -17.17 0.07 5.26 100.00 48.15 170.69
+56 2.02 -13.49 0.00 3.47 75.78 16.33 172.49
+57 1.43 -8.89 0.09 5.05 52.12 16.81 169.01
+58 5.86 -6.28 0.00 4.87 65.97 30.37 168.90
+59 6.66 -4.41 0.20 3.96 50.11 16.99 172.12
+60 -0.92 -13.90 0.29 4.06 92.38 21.80 139.78
+61 -5.09 -17.13 0.00 2.96 85.19 39.84 183.86
+62 -0.19 -14.01 0.00 4.08 75.93 24.28 177.34
+63 1.41 -8.83 0.26 4.04 74.69 40.87 168.01
+64 -2.72 -13.34 0.22 5.32 90.79 44.32 166.63
+65 -2.86 -13.92 0.00 5.04 79.72 47.75 186.75
+66 -1.59 -10.78 1.22 3.42 93.57 46.37 172.48
+67 -3.89 -13.75 0.33 3.42 99.71 48.86 158.09
+68 -4.59 -16.15 0.00 5.04 83.60 44.83 187.56
+69 -3.70 -13.28 0.00 8.32 71.16 32.58 193.26
+70 2.28 -9.96 0.00 5.53 59.05 32.43 192.94
+71 0.88 -9.43 0.09 2.95 60.81 16.03 184.41
+72 -2.62 -13.33 0.00 7.83 76.50 25.65 151.62
+73 1.38 -14.33 0.00 5.80 53.56 28.01 200.06
+74 3.80 -9.29 0.00 4.94 59.75 28.41 200.05
+75 3.81 -7.55 0.49 6.43 46.97 23.79 200.76
+76 -4.67 -16.70 0.43 3.81 95.92 20.36 182.52
+77 -2.34 -19.77 0.00 4.66 77.00 38.28 212.47
+78 2.31 -10.13 0.00 4.86 56.67 18.43 210.86
+79 -0.78 -12.05 0.00 4.89 61.92 24.48 178.78
+80 -2.22 -12.59 0.03 3.35 80.20 36.80 214.76
+81 0.15 -13.74 0.00 4.16 58.96 35.91 216.12
+82 -3.08 -11.31 0.52 4.59 98.57 37.34 184.55
+83 -3.71 -14.38 0.18 2.38 100.00 52.81 201.63
+84 -2.89 -16.94 0.00 3.38 90.33 55.87 214.32
+85 -3.19 -13.38 0.24 4.53 96.52 43.72 183.28
+86 -5.39 -17.97 0.34 3.35 86.35 38.14 193.47
+87 -3.92 -18.08 1.00 2.81 98.79 41.92 190.94
+88 -6.60 -14.47 0.41 5.50 100.00 61.95 193.69
+89 -5.34 -15.38 0.28 4.71 98.07 58.99 188.78
+90 -1.62 -16.86 0.79 3.98 99.31 39.29 220.88
+91 -4.97 -13.20 1.10 3.38 98.32 48.20 210.65
+92 -6.08 -16.35 0.23 3.40 98.66 50.78 193.54
+93 -6.44 -14.82 0.52 3.69 98.72 59.84 185.20
+94 -4.69 -16.38 0.00 3.24 82.65 50.36 204.12
+95 -0.36 -13.54 0.00 3.45 75.10 47.17 219.58
+96 2.85 -9.46 0.00 4.64 63.50 34.55 207.00
+97 -0.34 -9.11 0.44 6.86 72.94 33.26 182.93
+98 -5.15 -14.42 0.18 6.48 91.55 30.11 142.60
+99 -2.56 -16.73 0.00 5.38 59.36 33.26 230.03
+100 2.63 -10.73 0.08 4.45 60.34 32.50 208.68
+101 1.55 -9.52 0.00 4.58 60.35 28.48 201.34
+102 -5.24 -13.57 1.37 5.02 98.15 29.22 201.30
+103 -6.64 -19.40 0.02 4.09 97.22 49.39 234.90
+104 -3.71 -18.80 0.00 4.40 72.95 45.16 241.11
+105 1.78 -13.30 0.00 4.69 60.95 27.74 241.31
+106 3.39 -7.92 0.00 3.89 54.34 35.76 238.01
+107 0.18 -10.22 0.00 5.69 53.93 27.45 243.39
+108 3.69 -10.81 0.00 3.08 51.13 19.68 245.49
+109 7.39 -6.61 0.00 3.39 53.15 15.97 246.12
+110 8.59 -4.43 0.00 2.99 46.97 20.42 243.62
+111 9.18 -4.23 0.00 4.01 44.70 15.78 244.40
+112 9.59 -2.73 0.00 3.61 54.13 20.27 228.56
+113 9.47 -3.05 0.08 3.09 56.47 27.97 223.06
+114 5.16 -2.09 2.73 4.09 91.19 29.26 216.76
+115 0.23 -7.66 2.71 6.64 99.94 40.50 185.58
+116 -1.22 -12.02 0.50 3.88 94.26 48.84 239.64
+117 0.76 -13.38 0.08 2.38 82.13 48.60 244.22
+118 4.26 -11.17 0.04 1.70 80.08 43.79 248.04
+119 6.96 -6.73 0.07 2.56 72.67 33.25 248.32
+120 9.06 -3.33 0.61 2.70 58.13 33.15 213.05
+121 2.98 -4.09 3.28 5.19 99.05 29.71 185.18
+122 -1.19 -6.28 1.43 3.86 98.27 56.11 172.81
+123 2.22 -9.43 0.46 2.20 91.57 48.37 244.22
+124 5.99 -6.26 0.27 2.18 80.24 35.06 278.25
+125 6.48 -5.06 0.58 1.88 81.39 32.87 261.04
+126 5.88 -3.76 0.15 2.30 79.48 34.55 259.05
+127 6.77 -4.17 0.41 2.46 71.97 37.72 239.99
+128 4.68 -4.33 0.85 2.49 80.63 37.15 200.81
+129 4.36 -2.29 0.67 1.98 93.90 43.04 206.90
+130 6.69 -5.18 0.00 4.87 83.45 30.53 268.59
+131 5.21 -4.26 0.11 4.44 63.45 30.79 230.70
+132 4.08 -2.34 0.42 3.40 81.11 37.10 164.56
+133 -0.75 -8.88 0.24 5.85 73.08 40.26 239.64
+134 3.39 -11.23 0.13 2.38 65.99 35.25 274.53
+135 5.57 -6.90 1.23 2.60 65.74 35.18 262.67
+136 0.57 -4.40 1.03 4.11 98.55 33.30 239.24
+137 2.78 -5.68 1.56 3.30 97.94 56.46 242.22
+138 1.73 -5.38 0.61 2.16 94.09 44.07 236.48
+139 4.79 -7.78 0.11 2.99 71.50 41.08 294.09
+140 7.49 -5.06 0.00 3.87 61.32 35.06 287.17
+141 9.21 -2.86 0.00 3.59 60.76 32.63 296.41
+142 12.50 -1.19 0.00 2.49 57.76 28.49 300.21
+143 14.99 1.61 0.23 3.30 61.94 25.36 289.56
+144 10.48 1.47 0.00 4.16 63.14 26.04 301.78
+145 9.32 -2.58 0.00 6.76 44.54 23.41 299.10
+146 4.99 -7.41 0.00 6.86 45.66 21.81 311.50
+147 8.50 -6.69 0.00 5.06 42.91 21.34 304.56
+148 9.52 -2.01 0.00 5.40 41.01 22.61 269.86
+149 9.60 -2.28 0.00 4.86 47.84 23.68 308.92
+150 6.69 -2.99 0.00 4.86 41.99 25.58 289.47
+151 9.79 -3.13 0.00 3.76 56.83 29.00 308.01
+152 10.08 -2.49 0.00 5.76 37.77 21.12 310.27
+153 9.58 -3.41 0.00 4.95 47.43 17.85 291.03
+154 10.07 -3.89 0.00 4.66 49.07 17.48 292.42
+155 14.77 -1.79 0.00 4.67 40.10 16.03 300.45
+156 15.17 -0.67 0.00 5.65 33.56 15.63 299.94
+157 14.57 -0.27 0.00 5.35 34.96 14.84 300.24
+158 14.79 0.69 0.00 6.83 35.06 16.59 297.76
+159 13.45 -1.18 0.00 2.81 46.61 16.40 298.50
+160 15.34 -0.79 0.00 3.00 60.07 21.44 296.72
+161 15.36 -1.56 0.00 2.72 78.49 22.30 296.62
+162 16.98 0.20 0.00 3.52 73.38 24.15 293.44
+163 17.97 2.41 0.00 4.36 65.05 16.54 299.03
+164 16.27 1.62 0.00 5.15 33.29 16.24 300.13
+165 16.47 0.92 0.00 4.65 40.13 14.28 302.93
+166 16.67 1.51 0.00 5.64 30.28 13.47 303.55
+167 13.05 -1.67 0.00 3.06 33.39 13.08 298.37
+168 13.47 -2.19 0.00 2.24 51.86 17.81 299.44
+169 16.45 -1.06 0.00 2.65 41.29 18.97 296.13
+170 18.17 2.61 0.00 2.35 47.27 18.62 268.71
+171 16.65 3.32 0.00 2.73 39.76 16.76 285.82
+172 17.16 2.11 0.00 2.29 37.92 17.94 291.24
+173 16.88 2.51 0.00 4.27 53.56 15.96 268.45
+174 17.86 1.01 0.00 2.56 44.58 16.44 296.91
+175 20.38 2.62 0.00 5.16 42.62 13.79 301.75
+176 19.37 3.84 0.00 4.28 38.77 13.29 293.04
+177 20.87 3.63 0.00 3.56 36.94 16.04 297.93
+178 21.67 5.42 0.00 5.06 41.96 15.76 275.74
+179 17.65 5.52 0.00 6.53 38.21 15.36 296.96
+180 17.26 2.14 0.00 4.55 36.99 13.96 299.75
+181 19.67 3.82 0.00 3.86 35.87 14.76 278.86
+182 20.63 4.74 0.29 3.87 42.25 17.88 246.18
+183 17.02 4.12 0.79 2.79 68.01 20.71 248.38
+184 16.71 1.31 0.29 3.37 99.65 28.96 279.23
+185 16.92 1.03 0.00 3.08 72.51 27.95 263.98
+186 18.02 2.23 0.00 3.27 66.89 22.67 290.46
+187 19.22 1.74 0.00 4.25 52.97 18.71 291.26
+188 20.22 2.54 0.15 3.87 35.23 16.52 281.49
+189 19.32 4.44 0.36 3.31 58.51 17.00 252.48
+190 17.64 3.59 0.00 3.95 79.13 24.05 284.29
+191 19.62 2.74 0.11 2.68 62.57 27.72 277.48
+192 20.12 5.82 0.82 2.89 81.14 25.93 272.26
+193 19.53 5.81 0.56 2.29 68.22 23.75 274.72
+194 17.94 5.72 0.82 3.98 76.35 24.13 259.83
+195 16.83 3.52 0.14 3.59 74.90 26.43 248.06
+196 16.82 1.73 0.00 3.19 73.18 30.25 277.55
+197 17.22 2.52 0.00 4.69 60.42 21.25 287.18
+198 17.84 2.12 0.00 3.09 42.91 21.94 284.95
+199 19.32 3.63 0.00 3.57 54.57 21.46 281.75
+200 19.61 4.90 0.00 3.01 44.95 21.64 274.09
+201 18.92 5.22 0.00 5.37 54.99 20.63 276.02
+202 18.41 3.72 0.00 2.88 51.91 19.57 279.13
+203 18.02 3.80 0.04 1.90 68.83 22.47 279.13
+204 19.22 3.42 0.05 2.58 80.44 25.76 271.05
+205 19.12 4.73 0.37 2.47 62.29 22.28 258.30
+206 18.84 5.12 0.32 3.49 51.68 19.58 259.45
+207 18.11 3.44 0.13 2.16 68.42 20.75 248.87
+208 16.62 2.72 0.00 3.53 61.83 21.00 277.79
+209 17.34 2.12 0.00 3.17 47.85 19.78 278.04
+210 19.32 2.61 0.00 2.79 46.04 20.38 273.96
+211 20.54 4.63 0.00 4.59 38.47 21.04 259.63
+212 17.43 5.02 0.21 3.19 55.36 19.97 247.22
+213 17.55 4.67 0.00 3.49 67.35 22.65 271.59
+214 19.22 6.06 0.11 4.09 57.24 26.24 257.56
+215 18.23 5.58 0.00 3.67 60.85 27.13 267.05
+216 18.25 5.59 0.00 5.76 58.60 25.05 263.43
+217 16.52 2.76 0.00 4.61 62.32 22.09 270.68
+218 19.22 3.66 0.07 4.47 47.88 23.78 259.01
+219 20.44 5.08 0.03 3.81 55.81 22.89 259.87
+220 20.14 6.57 0.19 3.49 50.32 20.32 252.28
+221 19.12 8.31 0.58 2.82 56.20 23.29 249.06
+222 19.92 5.96 0.10 2.88 92.21 23.59 262.98
+223 19.22 4.97 0.00 3.59 55.52 22.59 253.62
+224 18.21 3.05 0.00 2.99 76.84 21.41 261.87
+225 19.12 4.85 0.06 2.79 64.53 20.39 247.85
+226 18.13 5.05 0.23 2.51 48.20 19.79 234.41
+227 16.62 4.09 1.27 3.09 91.48 27.91 227.74
+228 14.49 3.60 0.46 3.23 100.00 36.09 251.48
+229 13.53 1.28 0.00 4.87 62.22 28.72 247.44
+230 15.02 0.27 0.00 3.96 60.88 30.18 254.37
+231 16.45 2.18 0.00 5.67 60.70 24.75 253.27
+232 15.12 2.87 0.00 5.17 53.68 23.48 238.37
+233 10.81 -0.72 0.08 5.26 63.86 26.91 254.77
+234 14.02 -2.51 0.00 3.16 59.87 28.62 252.06
+235 16.53 0.57 0.00 3.89 52.18 21.79 250.67
+236 16.03 4.49 0.46 3.59 68.83 21.59 213.72
+237 13.72 2.48 0.91 3.27 83.10 32.36 167.84
+238 13.03 1.65 0.88 2.69 93.26 38.18 185.41
+239 13.23 0.75 0.71 2.95 99.87 33.66 242.61
+240 14.02 0.46 0.00 3.48 77.04 31.68 236.94
+241 15.34 1.46 0.00 4.77 65.05 24.16 241.47
+242 13.92 2.07 0.06 4.97 58.72 20.99 225.94
+243 13.14 1.49 0.11 4.76 59.76 25.54 214.67
+244 12.13 -0.09 0.19 4.45 67.72 27.04 220.19
+245 12.45 -1.09 0.00 3.93 58.00 25.23 251.37
+246 15.65 0.22 0.00 4.76 47.20 22.08 250.38
+247 15.95 2.01 0.00 5.26 45.22 21.87 246.77
+248 15.95 1.93 0.00 2.36 43.96 20.59 244.48
+249 17.55 2.99 0.00 2.68 43.76 21.49 242.69
+250 17.15 4.28 0.00 2.20 54.44 21.68 220.99
+251 16.42 3.28 0.52 2.89 63.52 25.53 220.64
+252 14.87 2.49 0.54 4.29 83.64 31.72 204.40
+253 7.42 2.18 0.98 3.48 100.00 32.16 103.24
+254 13.91 1.58 0.19 3.65 98.67 40.16 198.10
+255 12.14 -0.51 0.00 5.67 74.58 30.65 232.39
+256 11.32 -1.36 0.03 4.06 71.75 31.94 210.75
+257 14.15 0.47 0.00 3.89 75.69 29.58 223.98
+258 14.44 0.81 0.12 3.28 57.92 22.70 227.67
+259 14.76 1.59 0.00 4.96 62.82 23.15 226.09
+260 11.34 1.04 0.28 5.92 69.32 22.38 221.79
+261 13.35 -1.49 0.00 4.88 48.96 21.57 225.89
+262 16.36 -0.86 0.00 3.98 39.97 21.09 219.97
+263 15.65 3.61 0.13 6.45 48.14 19.79 217.76
+264 11.35 1.40 0.42 4.35 73.44 20.19 218.16
+265 11.74 -1.37 0.00 5.06 54.36 21.59 215.55
+266 8.12 -3.16 0.00 2.11 66.08 20.98 214.98
+267 10.04 -5.23 0.00 3.05 60.36 19.91 215.07
+268 10.03 -4.31 0.00 3.95 57.57 19.73 214.16
+269 10.80 -4.53 0.00 2.98 54.65 21.01 210.96
+270 13.46 -1.73 0.00 2.74 63.91 20.70 208.18
+271 12.75 -1.32 0.00 2.79 37.15 19.10 205.78
+272 13.65 -0.89 0.00 2.79 41.82 19.90 203.29
+273 13.54 0.11 0.00 3.21 42.68 19.81 201.67
+274 17.11 0.06 0.00 3.67 45.99 17.93 200.78
+275 13.11 0.65 0.00 4.06 36.62 18.66 206.22
+276 8.69 -3.86 0.00 2.26 64.50 19.66 207.12
+277 12.22 -2.16 0.00 3.48 41.53 23.92 203.82
+278 12.72 -0.94 0.00 3.97 43.17 19.29 204.13
+279 11.42 -1.62 0.00 3.81 44.65 19.97 197.13
+280 12.74 -2.44 0.00 2.00 59.12 21.09 198.91
+281 14.14 -0.15 0.00 3.30 44.47 23.03 194.12
+282 13.12 -0.93 0.00 1.99 43.10 20.47 194.34
+283 12.82 -1.26 0.00 3.69 41.91 18.91 193.52
+284 9.58 -4.35 0.00 2.29 61.89 20.66 188.93
+285 10.22 -3.84 0.00 3.53 59.59 21.57 189.33
+286 10.02 -2.44 0.00 4.36 58.57 23.34 160.09
+287 7.92 -1.27 0.00 4.37 69.32 27.72 167.62
+288 7.32 -3.63 0.71 4.58 72.61 28.51 175.41
+289 3.02 -6.93 0.70 6.34 86.42 22.77 161.80
+290 -1.71 -10.47 0.29 5.30 93.66 24.94 144.64
+291 -3.49 -10.98 0.00 6.93 79.88 37.19 155.32
+292 -1.08 -12.03 0.00 4.98 81.40 45.42 172.76
+293 3.63 -9.96 0.00 2.50 86.84 30.76 174.74
+294 5.32 -7.46 0.00 2.17 52.30 23.79 174.85
+295 5.32 -8.06 0.09 3.17 57.04 23.80 172.13
+296 4.24 -7.43 0.06 4.47 56.98 23.30 165.24
+297 -3.99 -13.34 0.00 2.88 70.43 23.60 140.86
+298 3.79 -13.79 0.00 5.04 70.83 15.26 166.54
+299 7.59 -7.58 0.23 3.36 25.34 14.01 164.45
+300 2.72 -7.56 0.45 3.14 70.59 14.58 139.93
+301 -5.90 -13.86 0.63 4.40 99.77 26.22 95.77
+302 -5.31 -16.45 0.00 2.68 97.96 62.30 154.31
+303 0.17 -14.47 0.00 4.09 97.11 44.25 156.05
+304 6.32 -7.28 0.00 2.96 64.15 27.95 154.43
+305 8.66 -5.19 0.00 3.96 47.00 16.84 155.34
+306 9.16 -4.49 0.00 2.87 37.03 17.27 148.87
+307 6.46 -3.96 0.00 5.19 34.29 16.06 144.26
+308 4.65 -7.06 0.00 4.06 59.17 18.76 142.19
+309 6.53 -6.36 0.00 3.97 81.60 26.95 140.67
+310 9.55 -4.29 0.00 3.27 80.96 26.06 141.38
+311 9.26 -2.19 0.00 5.86 45.76 20.65 138.17
+312 7.85 -1.61 0.00 6.43 55.01 22.23 135.87
+313 5.84 -4.05 0.00 8.03 60.44 26.46 135.99
+314 8.43 -5.07 0.00 3.89 56.19 21.78 134.69
+315 11.43 -3.19 0.00 3.55 40.17 13.30 136.07
+316 9.94 -2.56 0.00 3.16 26.44 12.49 133.59
+317 5.86 -3.17 0.08 3.86 59.38 15.67 112.77
+318 0.04 -12.64 1.22 2.08 100.00 35.36 95.14
+319 -6.10 -13.81 0.22 1.48 100.00 57.89 99.87
+320 -8.06 -19.19 0.03 1.69 98.79 58.61 130.73
+321 -10.46 -23.73 0.00 2.21 100.00 54.96 128.45
+322 -4.46 -23.15 0.00 3.29 100.00 32.30 129.60
+323 -2.54 -14.67 0.00 2.20 53.39 16.30 126.88
+324 -1.27 -12.49 0.00 2.77 51.66 27.55 123.59
+325 -1.64 -12.89 0.00 2.80 62.76 30.17 119.81
+326 0.95 -10.90 0.04 4.19 60.43 15.51 123.40
+327 -1.46 -10.36 0.00 4.16 42.39 18.86 110.00
+328 -5.60 -14.24 0.04 1.79 100.00 31.79 116.99
+329 -7.76 -15.29 0.58 3.36 100.00 42.30 99.88
+330 -6.27 -17.78 0.13 2.99 100.00 54.26 118.19
+331 -6.67 -17.25 0.00 4.37 85.10 26.45 116.35
+332 -5.40 -19.73 0.00 6.33 88.58 48.40 102.88
+333 0.54 -8.99 0.00 5.84 79.65 35.73 112.20
+334 3.42 -8.68 0.00 6.13 77.07 30.53 111.69
+335 3.96 -6.00 0.00 6.82 50.36 19.98 112.09
+336 -1.59 -12.59 0.10 4.88 52.15 17.90 89.59
+337 1.69 -12.87 0.00 5.11 73.93 38.81 105.97
+338 4.73 -6.31 0.00 4.86 70.35 32.69 103.77
+339 3.63 -6.50 0.00 5.85 54.56 21.50 104.38
+340 0.74 -8.45 0.00 4.34 87.39 31.83 100.72
+341 -0.77 -10.55 0.29 3.53 100.00 36.03 83.84
+342 -3.42 -12.07 0.39 1.99 100.00 49.81 64.59
+343 -5.88 -15.13 0.00 1.79 100.00 56.64 102.70
+344 -7.09 -16.40 0.00 3.97 95.94 49.86 95.71
+345 -1.31 -15.11 0.00 5.48 85.46 37.39 104.07
+346 1.74 -10.18 0.00 4.89 59.27 30.74 100.79
+347 3.95 -7.10 0.00 2.68 62.77 28.65 101.10
+348 0.59 -9.71 0.00 2.60 56.79 26.88 104.08
+349 3.22 -9.40 0.00 4.29 61.90 23.55 103.87
+350 3.07 -8.38 0.00 5.28 81.00 23.07 98.89
+351 6.03 -5.04 0.00 4.98 79.19 33.55 99.69
+352 8.73 -3.12 0.00 5.17 57.95 18.46 101.39
+353 4.72 -7.08 0.00 3.65 43.94 17.36 100.49
+354 0.11 -11.11 0.00 1.85 79.72 22.30 98.16
+355 -0.19 -11.97 0.00 3.18 79.87 38.47 100.29
+356 -0.97 -11.52 0.00 4.09 86.56 45.42 97.28
+357 0.24 -8.41 0.06 6.32 80.52 47.96 99.19
+358 -3.36 -11.92 0.11 5.28 93.06 35.04 99.37
+359 0.23 -12.02 0.00 5.19 76.27 22.31 100.27
+360 3.61 -5.19 0.00 9.60 59.22 18.22 97.70
+361 5.71 -5.56 0.00 5.88 87.32 32.98 99.19
+362 9.82 -3.42 0.00 3.89 77.26 30.36 100.09
+363 4.62 -5.91 0.00 3.10 55.35 27.79 95.48
+364 2.02 -9.06 0.00 2.69 82.81 22.67 104.86
+365 6.54 -4.84 0.00 4.98 36.53 8.57 103.98
+366 0.84 -7.48 0.00 3.06 73.51 10.85 102.39
diff --git a/inst/extdata/example1/Input/data_weather_gridmet/weath.1981 b/inst/extdata/example1/Input/data_weather_gridmet/weath.1981
new file mode 100644
index 00000000..1184a629
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_gridmet/weath.1981
@@ -0,0 +1,367 @@
+# weather for site gridmet example at -105.58 / 39.59 year = 1981
+# DOY, Tmax_C, Tmin_C, PPT_cm, sfcWind_mPERs, hursmax_pct, hursmin_pct, rsds_WPERm2
+1 2.71 -10.11 0.00 2.36 99.40 28.41 99.27
+2 2.80 -8.72 0.00 3.97 63.93 25.73 96.38
+3 1.79 -10.50 0.00 2.68 100.00 28.94 98.07
+4 0.12 -9.22 0.09 3.06 95.93 36.06 81.88
+5 -1.52 -11.45 0.06 2.40 100.00 47.65 69.44
+6 -1.72 -15.41 0.00 3.29 100.00 33.13 102.36
+7 4.18 -10.14 0.00 2.77 58.44 20.25 101.18
+8 3.50 -10.83 0.00 3.17 46.22 15.02 102.48
+9 0.96 -11.21 0.00 2.27 45.06 14.44 102.26
+10 1.08 -11.45 0.00 2.60 66.43 27.06 103.27
+11 -0.93 -13.84 0.00 2.37 87.25 22.67 106.95
+12 3.21 -12.43 0.00 3.79 45.98 7.46 107.78
+13 1.79 -11.71 0.00 3.70 21.38 9.27 108.26
+14 1.66 -12.33 0.00 2.38 58.78 13.32 107.17
+15 -2.03 -14.32 0.04 2.59 59.25 20.52 94.57
+16 -7.31 -17.90 0.26 2.08 100.00 32.22 102.40
+17 -3.03 -16.90 0.00 2.56 100.00 67.60 109.84
+18 -3.59 -15.30 0.00 3.39 100.00 60.90 110.76
+19 -2.62 -15.88 0.09 3.79 100.00 40.86 112.96
+20 -3.71 -15.29 0.00 4.59 100.00 35.51 114.25
+21 2.31 -14.50 0.00 3.88 66.32 13.46 113.68
+22 5.21 -9.73 0.00 3.19 60.01 21.41 116.26
+23 6.12 -8.21 0.00 3.19 43.76 16.41 118.05
+24 1.79 -11.01 0.05 5.06 49.84 12.65 118.08
+25 -6.10 -16.03 0.00 6.16 88.70 24.23 120.18
+26 -7.92 -19.11 0.00 4.55 92.77 34.91 121.38
+27 -3.92 -16.81 0.03 4.81 98.18 40.73 121.27
+28 1.26 -13.13 0.00 2.96 100.00 44.68 115.35
+29 -3.00 -13.83 0.00 3.76 99.95 39.29 116.40
+30 -1.89 -14.12 0.10 5.93 87.97 28.81 115.10
+31 -8.68 -17.63 0.20 4.58 100.00 28.04 96.87
+32 -13.04 -20.77 0.17 6.00 95.34 46.09 87.84
+33 -7.56 -21.39 0.00 7.31 80.95 54.69 134.00
+34 -3.54 -16.12 0.00 3.39 65.71 33.80 134.91
+35 -4.49 -16.24 0.00 2.66 74.25 36.71 126.66
+36 -5.84 -17.14 0.00 2.85 76.31 41.83 139.51
+37 -5.05 -15.16 0.00 5.88 70.17 35.64 111.03
+38 -8.17 -16.91 0.00 6.58 82.99 35.31 128.49
+39 -5.47 -14.79 0.00 8.37 68.67 40.39 135.44
+40 -4.64 -15.04 0.39 4.64 94.93 38.55 124.58
+41 -11.12 -25.86 1.30 4.96 100.00 52.03 88.37
+42 -5.66 -25.05 0.00 7.00 74.05 43.67 147.92
+43 -4.45 -15.90 0.00 4.48 89.49 45.32 147.60
+44 -0.01 -13.34 0.00 3.59 83.48 41.91 149.31
+45 4.78 -8.85 0.00 4.95 66.64 14.31 144.39
+46 0.46 -7.74 0.00 4.17 62.75 16.74 152.01
+47 4.16 -9.62 0.00 3.58 60.12 31.71 152.02
+48 4.17 -7.16 0.00 4.19 71.50 32.84 132.05
+49 3.06 -9.20 0.00 5.33 75.22 17.86 156.21
+50 6.17 -6.46 0.00 4.67 64.85 21.93 155.92
+51 3.36 -8.75 0.69 5.24 55.12 25.67 139.03
+52 -6.64 -14.23 0.43 5.81 100.00 30.51 142.81
+53 -2.58 -14.81 0.00 6.24 91.24 47.18 164.22
+54 4.45 -9.55 0.00 3.47 67.27 18.01 166.29
+55 5.78 -8.06 0.00 3.35 47.32 17.44 170.22
+56 5.09 -7.74 0.00 3.58 46.65 13.61 170.02
+57 1.29 -7.55 0.00 6.06 51.88 15.62 135.31
+58 -0.46 -11.36 0.00 3.77 72.94 21.88 174.20
+59 2.28 -11.03 0.07 2.28 51.48 23.03 174.92
+60 0.91 -11.13 0.19 2.50 95.29 20.65 139.69
+61 2.09 -12.22 0.68 4.56 100.00 34.70 160.63
+62 -1.88 -12.42 0.94 4.51 100.00 32.90 152.01
+63 -5.22 -17.51 0.52 6.19 100.00 51.75 144.42
+64 -1.42 -17.72 0.19 2.88 92.51 27.07 187.29
+65 -2.31 -14.30 0.44 2.68 99.30 47.09 164.73
+66 -6.00 -15.13 0.69 3.48 100.00 47.11 160.08
+67 -3.53 -17.33 0.06 2.98 100.00 53.74 180.90
+68 -2.30 -15.61 0.06 2.39 97.84 44.57 189.66
+69 -2.11 -13.59 0.14 2.18 99.48 41.05 145.58
+70 -1.69 -14.19 0.28 3.08 97.91 45.16 183.90
+71 0.09 -13.23 0.47 2.98 100.00 39.80 179.68
+72 -2.18 -12.43 0.00 2.89 99.96 39.08 100.21
+73 0.80 -12.32 0.00 3.10 87.66 32.86 188.64
+74 1.81 -11.33 0.00 3.46 84.93 27.85 195.66
+75 3.89 -10.62 0.07 4.18 75.85 24.74 196.58
+76 -2.67 -11.80 0.03 6.29 83.56 21.59 158.65
+77 -3.93 -13.14 0.09 1.98 100.00 26.57 132.58
+78 0.67 -15.48 0.11 2.84 96.26 42.40 189.99
+79 1.82 -9.71 0.33 4.42 85.73 38.07 161.22
+80 -3.07 -12.38 0.31 7.49 100.00 33.41 162.84
+81 -1.09 -13.82 0.00 2.55 100.00 46.44 191.11
+82 0.33 -12.18 0.73 3.59 86.62 36.45 174.08
+83 1.20 -10.39 0.39 3.18 100.00 34.45 190.50
+84 3.58 -13.02 0.00 3.58 99.33 20.41 209.21
+85 6.22 -7.21 0.00 4.86 58.50 23.13 185.08
+86 2.53 -7.39 0.54 7.73 69.41 19.30 174.26
+87 -1.39 -13.99 1.05 5.21 99.27 23.37 194.00
+88 0.68 -15.24 0.06 5.88 100.00 39.26 213.70
+89 2.39 -11.51 0.05 7.05 89.60 20.81 202.53
+90 -3.64 -15.33 0.00 9.05 74.51 22.66 230.29
+91 4.96 -10.70 0.04 5.53 54.51 18.32 216.65
+92 5.89 -7.32 0.00 5.46 56.81 21.06 199.70
+93 -1.01 -10.83 1.01 4.27 89.12 23.51 189.98
+94 -6.35 -13.61 0.06 6.36 82.00 27.06 142.55
+95 1.94 -14.84 0.00 4.73 59.01 23.72 224.52
+96 4.66 -7.33 0.13 5.73 43.75 18.22 219.39
+97 4.77 -6.11 0.10 5.80 54.54 23.92 217.14
+98 0.45 -7.74 0.46 4.22 96.84 23.50 200.95
+99 7.06 -7.11 0.00 5.13 64.73 29.66 225.62
+100 8.56 -4.09 0.00 4.75 46.88 19.02 227.82
+101 8.47 -3.91 0.00 4.35 47.70 17.82 208.10
+102 8.46 -4.57 0.00 4.26 47.33 21.16 228.82
+103 6.47 -4.98 0.00 2.59 52.39 21.87 171.19
+104 8.07 -5.86 0.00 4.49 76.00 27.21 229.73
+105 9.37 -3.43 0.00 3.86 74.99 27.53 202.21
+106 9.77 -4.28 0.00 5.37 70.52 22.97 234.64
+107 12.39 -3.08 0.10 3.09 63.27 19.72 232.21
+108 9.88 -2.51 0.33 3.09 52.22 18.52 225.24
+109 6.06 -3.78 1.57 3.30 98.78 30.78 191.72
+110 7.55 -6.53 0.43 3.26 99.42 33.03 231.77
+111 6.46 -5.70 0.11 5.23 67.16 27.71 221.69
+112 2.76 -6.61 0.03 4.47 71.88 30.52 216.14
+113 8.97 -6.22 0.00 2.49 62.37 28.61 242.44
+114 11.07 -3.70 0.00 2.76 61.10 25.22 244.45
+115 14.18 -1.69 0.00 3.08 56.01 21.67 236.71
+116 13.17 -1.22 0.00 4.16 49.86 17.72 247.52
+117 11.19 -2.78 0.00 2.40 45.56 15.55 203.64
+118 10.37 -1.64 0.00 3.07 73.38 22.13 250.81
+119 12.15 -2.33 0.00 3.66 53.49 26.69 249.02
+120 9.79 -1.47 0.00 3.09 57.29 25.34 241.29
+121 10.19 -2.11 0.12 3.00 68.93 36.51 269.34
+122 10.42 1.10 0.48 4.28 71.10 32.29 256.94
+123 7.14 -0.41 0.97 3.04 90.06 31.12 251.35
+124 4.28 -5.93 0.74 2.69 70.50 40.10 284.31
+125 6.99 -6.50 0.71 3.89 98.80 35.46 264.57
+126 5.10 -2.72 0.36 4.26 91.97 31.65 277.31
+127 1.89 -5.56 0.17 4.93 57.80 26.46 273.04
+128 0.78 -8.58 0.68 4.45 54.75 24.26 254.74
+129 -2.40 -10.72 0.19 4.49 89.06 28.69 254.58
+130 4.58 -8.73 0.00 2.76 75.16 33.65 269.86
+131 5.69 -3.60 0.33 5.66 68.49 27.49 245.06
+132 3.91 -7.36 0.35 4.13 62.05 23.05 210.90
+133 0.67 -8.39 0.17 2.98 92.24 35.15 289.80
+134 8.57 -6.26 0.00 3.24 74.43 30.14 289.96
+135 8.08 -1.34 0.20 5.46 53.43 23.06 262.64
+136 3.46 -3.91 1.08 2.18 76.04 23.76 235.65
+137 0.77 -5.81 0.93 4.89 88.13 44.95 229.58
+138 2.44 -5.74 0.17 4.61 95.88 58.59 274.83
+139 9.33 -5.38 0.04 3.10 94.52 35.34 288.01
+140 8.09 -1.56 0.05 6.45 64.47 26.74 231.83
+141 1.78 -2.64 0.08 7.65 57.05 30.90 254.72
+142 4.88 -4.41 0.24 5.46 71.96 39.13 271.60
+143 7.38 -3.71 0.30 3.10 82.65 38.88 294.47
+144 8.99 -2.42 0.16 2.16 77.53 35.20 288.30
+145 8.80 -1.28 0.09 2.67 64.84 32.16 246.32
+146 10.67 -0.88 0.09 2.76 71.04 36.86 243.96
+147 10.79 -0.11 0.11 2.38 68.76 35.04 280.64
+148 11.28 1.99 1.35 2.40 85.08 32.70 275.50
+149 7.22 -0.72 1.72 3.19 93.26 36.62 239.54
+150 9.79 -2.12 0.60 2.60 97.28 45.37 284.08
+151 11.54 -0.34 0.10 2.96 69.63 34.76 278.25
+152 11.94 -1.23 0.17 2.27 61.72 24.77 274.53
+153 13.32 -1.32 0.71 2.31 50.13 21.61 289.14
+154 10.66 1.24 1.06 2.40 76.84 21.71 247.46
+155 12.35 -1.34 0.18 2.11 76.30 33.06 290.10
+156 13.23 -1.14 0.00 2.61 58.07 33.66 284.34
+157 16.55 0.67 0.00 2.87 69.02 24.22 294.53
+158 17.45 4.06 0.00 5.45 44.38 20.15 284.42
+159 17.55 4.98 0.00 6.25 38.84 19.56 288.84
+160 17.65 4.68 0.00 5.13 41.39 19.38 287.11
+161 18.01 3.67 0.00 2.74 50.18 19.84 277.25
+162 17.54 4.54 0.05 3.32 42.55 17.99 295.17
+163 17.45 3.54 0.00 5.04 51.53 14.47 299.03
+164 15.52 2.84 0.00 5.83 35.05 13.37 300.13
+165 8.59 -2.49 0.00 4.52 41.40 13.65 268.69
+166 5.92 -8.16 0.00 4.58 55.69 17.49 303.28
+167 13.02 -5.44 0.00 3.96 45.15 16.65 303.45
+168 15.03 1.20 0.00 6.43 27.61 14.05 302.16
+169 13.77 0.45 0.00 2.89 33.57 13.75 269.39
+170 15.94 1.84 0.00 4.85 33.12 18.28 295.64
+171 18.14 3.65 0.00 4.55 38.55 17.99 294.64
+172 18.03 5.69 0.00 4.62 38.14 16.91 295.73
+173 18.24 3.76 0.05 2.87 46.05 15.63 300.14
+174 20.03 4.96 0.00 3.67 42.61 14.62 295.35
+175 20.12 6.33 0.04 2.14 34.94 12.95 286.70
+176 19.42 4.62 0.25 3.50 53.02 17.16 288.46
+177 19.85 6.05 0.30 3.16 58.47 17.69 274.10
+178 18.65 5.87 0.20 2.69 57.95 17.11 258.35
+179 16.73 5.86 0.40 3.07 61.42 20.16 260.67
+180 15.66 3.45 0.63 3.09 67.39 22.11 272.71
+181 17.02 4.14 0.29 3.00 72.93 26.67 282.81
+182 14.93 4.83 1.03 3.21 82.93 31.89 230.63
+183 12.16 4.26 0.56 3.30 95.31 41.64 164.31
+184 15.40 3.15 0.21 2.38 96.70 38.56 273.17
+185 14.22 3.56 0.19 3.90 71.49 32.28 271.26
+186 17.34 3.56 0.00 2.98 65.52 26.45 290.34
+187 19.82 4.25 0.03 2.58 49.12 21.50 289.95
+188 19.82 7.36 0.64 2.27 49.36 21.42 273.76
+189 16.01 7.33 0.23 4.12 63.01 24.37 258.81
+190 17.52 4.24 0.38 3.30 58.54 31.18 263.24
+191 17.90 4.65 0.20 2.67 83.86 31.36 268.72
+192 18.21 4.86 0.45 2.70 65.00 33.76 246.60
+193 17.03 6.16 0.51 2.79 85.61 33.06 264.85
+194 15.62 5.79 0.25 2.66 80.89 32.45 238.31
+195 16.22 4.47 0.03 3.30 69.47 34.95 256.73
+196 17.52 4.55 0.71 2.78 67.92 33.73 259.61
+197 16.12 4.54 0.26 2.88 81.08 30.41 243.01
+198 14.41 3.46 0.38 1.69 88.00 31.17 206.70
+199 14.91 3.16 0.21 1.99 87.18 35.66 264.15
+200 17.61 4.13 0.00 4.56 67.93 24.40 280.85
+201 18.62 4.25 0.00 3.37 35.88 19.53 282.27
+202 18.91 5.98 0.04 4.69 37.81 16.47 282.27
+203 19.11 6.07 0.07 3.36 38.44 17.24 269.44
+204 18.52 5.54 0.11 2.79 45.27 19.83 265.98
+205 17.21 5.84 0.15 3.10 48.71 21.30 262.27
+206 15.73 4.06 0.40 3.08 72.85 25.06 224.74
+207 13.27 2.75 0.55 3.29 94.34 30.15 208.82
+208 14.99 2.07 0.08 2.67 90.04 31.38 272.19
+209 15.82 1.62 0.03 2.55 74.03 24.60 276.24
+210 17.11 3.54 0.00 2.90 48.52 20.62 273.03
+211 18.63 4.35 0.12 2.89 43.69 21.31 268.03
+212 17.14 5.04 0.00 2.79 50.79 20.42 265.00
+213 16.52 5.64 0.09 2.59 67.78 27.21 235.40
+214 17.12 4.44 0.42 3.10 68.77 30.89 258.36
+215 18.02 5.06 0.05 3.40 84.09 31.29 258.23
+216 18.82 5.95 0.00 2.49 75.82 32.40 263.85
+217 18.39 5.75 0.07 3.10 45.12 23.01 263.51
+218 16.59 5.43 0.00 3.30 73.99 26.38 267.45
+219 14.02 1.77 0.00 2.70 99.49 30.40 264.69
+220 13.92 0.75 0.32 2.29 83.75 36.73 257.39
+221 10.71 1.96 0.76 3.17 99.42 36.51 207.48
+222 10.60 -1.06 0.43 2.28 100.00 44.96 230.30
+223 9.52 -1.56 0.66 2.60 100.00 45.78 223.21
+224 8.62 2.71 0.70 2.30 100.00 57.54 155.38
+225 12.52 0.61 0.67 3.27 100.00 43.33 248.38
+226 14.00 1.27 0.40 2.99 87.54 40.04 248.38
+227 13.62 3.04 0.71 1.88 96.87 39.69 216.97
+228 12.12 2.54 0.81 2.80 93.67 41.26 223.09
+229 12.62 0.35 0.22 1.80 100.00 44.36 245.55
+230 13.52 1.33 0.09 2.98 98.48 34.51 254.96
+231 15.12 1.68 0.00 2.79 64.88 28.98 254.25
+232 16.41 2.45 0.00 2.08 65.79 29.94 245.37
+233 17.03 5.22 0.72 2.48 72.96 29.04 242.97
+234 13.52 4.15 0.35 3.28 83.70 28.14 228.13
+235 15.12 1.94 0.14 2.58 64.86 34.77 238.16
+236 15.05 3.84 0.07 3.09 60.23 28.91 215.46
+237 15.43 3.67 0.26 3.19 72.84 30.83 225.18
+238 15.21 4.06 0.14 2.50 58.54 30.16 237.15
+239 13.60 1.84 0.11 2.20 83.91 33.31 226.52
+240 14.92 1.93 0.04 2.47 90.24 35.00 232.30
+241 15.33 4.05 0.07 3.87 62.04 32.97 225.34
+242 15.64 3.97 0.18 3.97 69.78 32.83 220.34
+243 14.55 4.41 0.50 2.38 79.48 29.99 204.64
+244 13.85 2.20 0.36 3.45 79.26 28.72 233.71
+245 16.25 2.42 0.30 3.08 54.71 30.55 229.00
+246 13.09 3.32 0.30 2.98 81.12 25.01 207.71
+247 15.66 1.67 0.00 3.48 81.41 29.08 239.59
+248 13.34 3.38 0.27 3.19 68.48 27.40 193.89
+249 10.30 0.60 0.56 3.59 82.05 34.70 190.96
+250 6.19 0.61 0.60 1.68 100.00 46.54 115.70
+251 13.15 -1.26 0.55 2.29 92.15 39.61 233.69
+252 12.87 0.50 0.43 2.47 86.03 32.77 224.97
+253 11.06 1.71 0.33 2.90 79.17 33.11 199.91
+254 11.85 0.22 0.00 3.48 72.68 33.90 205.47
+255 12.46 0.51 0.00 2.59 65.27 34.48 218.19
+256 13.56 2.21 0.05 3.20 63.58 29.17 226.28
+257 13.56 2.48 0.09 1.81 50.65 25.10 221.61
+258 12.65 0.67 0.04 2.92 75.25 24.31 219.34
+259 10.62 -1.79 0.00 2.20 86.64 34.96 222.93
+260 10.74 -3.01 0.00 2.66 85.87 24.16 227.26
+261 14.37 -2.12 0.00 2.89 37.70 14.85 226.09
+262 13.76 0.51 0.00 4.59 28.11 14.65 221.87
+263 14.05 1.81 0.00 3.87 48.56 17.09 209.27
+264 12.55 1.42 0.00 4.17 60.58 25.39 197.06
+265 14.46 1.91 0.00 4.30 62.26 27.67 205.31
+266 12.15 0.89 0.05 2.90 57.56 25.92 159.31
+267 11.46 0.41 0.10 2.29 69.77 27.87 194.24
+268 10.77 -0.71 0.00 5.86 74.36 25.60 200.77
+269 9.34 -2.72 0.00 4.43 67.18 17.80 209.88
+270 12.17 -2.57 0.00 3.78 44.48 20.66 205.17
+271 13.76 0.89 0.00 4.66 41.26 20.45 202.99
+272 13.36 1.41 0.00 4.86 56.62 20.56 191.94
+273 10.95 1.18 0.00 3.69 56.65 22.92 177.60
+274 10.93 -1.65 0.00 2.58 88.97 29.42 202.83
+275 10.94 0.84 0.07 3.86 75.87 34.97 171.22
+276 5.63 -1.54 0.06 5.06 82.78 46.24 173.66
+277 8.11 -3.80 0.14 4.16 93.87 45.23 180.53
+278 5.82 -2.13 0.09 4.53 88.47 33.46 197.41
+279 8.82 -3.73 0.00 3.08 85.04 35.92 199.02
+280 9.62 -3.35 0.00 3.76 71.56 30.82 197.83
+281 7.04 -1.72 0.03 5.35 69.91 31.12 153.41
+282 4.53 -2.34 0.00 2.91 84.56 34.94 185.94
+283 7.94 -5.41 0.00 4.06 79.67 40.82 188.42
+284 8.65 -0.55 0.03 7.53 68.11 31.09 182.08
+285 5.02 -4.22 0.00 5.64 80.35 29.83 159.39
+286 4.22 -1.57 0.19 3.93 72.08 37.25 116.29
+287 4.34 -3.67 0.83 3.44 99.30 36.34 165.91
+288 -0.75 -4.53 1.72 4.15 100.00 36.34 127.80
+289 -1.25 -8.33 0.25 4.86 100.00 54.53 134.67
+290 0.13 -9.21 0.00 5.08 90.87 58.46 168.39
+291 3.81 -8.63 0.00 3.06 96.17 34.70 178.12
+292 6.82 -5.76 0.00 4.27 56.71 18.44 179.84
+293 6.44 -5.14 0.00 3.77 34.23 17.93 176.62
+294 3.12 -7.19 0.00 2.07 77.81 20.68 171.62
+295 0.69 -8.19 0.00 2.73 74.43 28.92 170.22
+296 2.99 -8.69 0.00 3.83 74.00 32.52 167.94
+297 -0.27 -8.17 0.60 3.15 76.89 31.63 131.26
+298 -4.56 -11.06 0.10 3.26 100.00 45.65 163.11
+299 8.01 -8.55 0.03 4.15 87.27 24.54 160.04
+300 7.73 -4.05 0.00 4.14 48.27 24.46 153.13
+301 6.53 -4.16 0.00 4.84 56.53 26.50 143.11
+302 4.22 -3.26 0.32 7.64 76.47 34.03 136.53
+303 -4.16 -9.43 0.85 3.70 94.71 34.62 133.34
+304 -3.39 -11.28 0.43 3.79 100.00 65.71 155.62
+305 3.20 -9.87 0.00 5.89 91.13 39.28 148.56
+306 3.74 -6.89 0.00 4.90 88.57 39.67 144.27
+307 5.79 -6.79 0.00 2.76 79.11 30.82 146.34
+308 7.49 -5.79 0.00 3.47 72.67 19.40 145.85
+309 5.39 -6.66 0.00 2.26 48.95 19.46 141.06
+310 7.00 -4.63 0.00 3.25 56.71 25.95 125.78
+311 4.31 -4.79 0.49 3.89 81.26 28.43 120.71
+312 0.40 -7.55 0.08 2.80 95.14 33.01 106.21
+313 1.48 -11.47 0.00 3.07 79.63 39.89 138.46
+314 3.53 -8.59 0.00 2.10 71.00 24.38 138.38
+315 3.41 -9.29 0.00 2.06 54.09 22.47 135.46
+316 5.49 -8.01 0.00 3.47 51.50 23.15 132.78
+317 7.30 -5.58 0.00 3.97 45.59 24.05 127.58
+318 6.81 -3.97 0.00 5.83 62.68 26.15 126.58
+319 5.10 -5.02 0.00 5.12 70.34 29.19 118.54
+320 8.80 -3.75 0.00 3.46 73.04 29.63 124.40
+321 9.71 -3.67 0.00 4.58 52.09 14.07 125.89
+322 -0.19 -11.46 0.28 7.57 85.61 13.18 92.24
+323 -5.52 -14.99 0.00 4.06 90.85 37.40 122.49
+324 2.01 -13.99 0.00 3.94 81.89 21.70 121.30
+325 2.08 -10.66 0.00 5.04 79.01 24.84 115.97
+326 2.90 -7.77 0.00 5.96 76.56 30.12 115.27
+327 2.36 -8.96 0.51 5.11 97.95 32.26 104.27
+328 6.48 -5.19 0.00 5.93 73.26 21.48 117.69
+329 2.01 -11.26 0.76 4.56 54.85 20.99 105.10
+330 -6.43 -16.56 0.11 2.46 100.00 26.82 115.50
+331 -3.73 -14.84 0.18 3.04 90.12 42.00 110.72
+332 -3.62 -13.81 0.08 2.96 92.94 49.85 110.61
+333 -1.90 -12.81 0.77 2.45 97.16 54.14 95.37
+334 -8.95 -15.61 0.07 8.73 100.00 43.87 108.60
+335 -7.99 -18.67 0.07 7.93 77.06 65.76 105.67
+336 -3.66 -13.83 0.00 8.99 70.78 61.10 106.37
+337 -3.18 -9.69 0.00 6.40 75.58 54.21 107.38
+338 1.07 -9.91 0.00 3.66 62.63 28.75 106.67
+339 1.22 -6.58 0.00 4.97 48.77 30.35 105.77
+340 4.64 -5.28 0.00 5.36 50.21 26.46 104.18
+341 5.05 -4.66 0.00 3.46 46.66 23.10 102.77
+342 4.63 -5.48 0.00 3.56 52.09 25.35 102.39
+343 7.11 -4.09 0.00 4.38 43.30 16.42 100.27
+344 4.74 -4.84 0.00 4.39 36.70 19.85 99.09
+345 -0.63 -6.98 0.36 3.28 77.00 25.27 70.58
+346 -1.58 -9.41 0.00 3.23 81.93 33.78 102.77
+347 -3.79 -11.57 0.28 3.46 81.31 34.75 93.12
+348 -3.21 -12.90 0.14 6.13 97.40 54.06 90.01
+349 -1.79 -10.58 0.34 6.80 80.08 52.20 96.26
+350 -5.27 -13.96 0.25 6.03 90.71 49.65 97.05
+351 -10.99 -17.07 0.25 3.65 94.98 53.46 103.87
+352 -2.92 -15.68 0.00 4.48 67.16 39.11 101.39
+353 -0.68 -8.41 0.03 5.23 69.96 33.94 86.34
+354 0.34 -3.94 0.31 8.60 79.44 58.12 88.88
+355 -3.50 -10.79 1.35 2.56 98.55 55.58 46.35
+356 -10.31 -17.88 0.87 2.78 99.91 55.28 82.27
+357 -14.81 -23.36 0.00 3.86 80.44 49.50 103.48
+358 -10.79 -23.39 0.00 4.66 68.63 38.01 104.29
+359 -9.27 -17.27 0.23 4.55 76.66 44.12 97.88
+360 -13.79 -20.56 0.18 4.66 87.05 51.14 101.67
+361 -10.05 -19.28 1.43 2.96 99.58 59.20 68.52
+362 -13.88 -22.27 0.00 4.23 80.12 49.11 93.80
+363 -7.10 -20.25 0.00 5.12 73.70 60.02 103.29
+364 -3.16 -9.97 0.65 5.44 90.23 60.83 91.79
+365 -6.69 -12.42 0.57 3.72 90.42 53.39 95.28
diff --git a/inst/extdata/example1/Input/data_weather_maca/weath.1980 b/inst/extdata/example1/Input/data_weather_maca/weath.1980
new file mode 100644
index 00000000..19a661b0
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_maca/weath.1980
@@ -0,0 +1,368 @@
+# weather for site maca example at -105.58 / 39.59 year = 1980
+# DOY, Tmax_C, Tmin_C, PPT_cm, uas_mPERs, vas_mPERs, hursmax_pct, hursmin_pct, rsds_WPERm2
+1 -0.01 -11.99 0.00 3.31 -0.85 83.82 33.27 107.19
+2 1.27 -10.98 0.00 4.20 0.16 87.07 33.74 103.02
+3 1.92 -8.39 0.00 4.43 -0.39 92.60 44.30 98.53
+4 -0.30 -12.19 0.00 3.55 -1.13 99.95 47.18 104.83
+5 2.59 -9.32 0.05 5.20 0.67 88.96 38.51 94.22
+6 2.36 -5.47 0.17 4.33 1.44 91.39 53.32 84.92
+7 1.31 -12.42 0.04 2.48 -2.06 95.81 50.51 101.75
+8 -1.29 -15.72 0.00 4.68 -1.43 73.09 46.72 100.37
+9 -2.03 -12.36 0.00 5.14 -1.80 71.72 34.23 100.46
+10 -7.37 -17.86 0.00 3.19 -3.01 56.63 37.96 101.56
+11 -2.26 -13.70 0.00 4.01 -2.66 87.06 32.75 98.21
+12 1.45 -8.76 0.04 3.86 -2.18 94.92 42.37 97.27
+13 -0.45 -11.69 0.00 2.20 1.27 71.93 51.41 88.14
+14 -1.86 -12.80 0.08 1.74 -2.15 78.19 48.84 99.31
+15 -4.31 -17.34 0.00 2.82 -0.40 80.55 32.28 110.65
+16 -3.82 -14.63 0.00 3.86 0.28 68.77 30.43 113.33
+17 -4.41 -13.59 0.00 3.84 0.27 71.64 24.64 114.64
+18 -4.50 -15.44 0.29 1.91 -1.95 99.88 36.41 112.11
+19 -5.80 -16.78 0.00 3.72 -1.73 94.95 33.64 114.54
+20 -2.88 -14.31 0.04 3.80 -2.31 71.88 37.54 118.84
+21 -3.49 -14.30 0.00 2.86 -3.47 55.24 13.55 128.65
+22 3.97 -13.27 0.00 4.47 -1.21 51.60 11.65 130.84
+23 5.25 -8.02 0.00 4.77 -0.21 50.84 10.07 123.71
+24 5.25 -7.08 0.00 4.30 -0.61 62.34 28.04 112.36
+25 2.88 -5.61 0.00 4.81 -0.06 70.15 43.75 96.92
+26 6.18 -3.81 0.29 4.29 1.89 99.07 49.79 99.92
+27 4.90 -7.22 0.25 3.99 0.66 94.92 43.74 111.12
+28 -1.29 -12.68 0.00 3.91 -0.54 99.94 38.58 134.32
+29 -2.04 -10.49 0.03 5.41 0.25 60.06 26.82 106.29
+30 -3.91 -14.06 0.00 4.54 0.59 43.69 22.55 110.88
+31 -2.46 -10.47 0.33 4.68 3.05 58.61 36.49 118.97
+32 -2.62 -23.24 0.68 2.88 -2.45 100.00 40.54 143.27
+33 -11.72 -29.23 0.00 4.43 -0.86 99.97 36.37 151.17
+34 -11.07 -17.25 0.37 2.03 0.38 99.65 46.57 115.73
+35 -11.53 -22.21 0.10 2.64 -2.40 93.27 52.70 131.28
+36 -13.15 -23.32 0.00 2.47 -4.48 96.67 46.23 130.91
+37 -9.55 -19.67 0.00 3.05 -2.56 75.23 44.16 135.24
+38 -3.85 -20.32 0.00 2.81 -0.25 88.25 29.08 157.53
+39 -6.22 -17.65 0.03 1.51 -0.45 75.62 48.17 116.59
+40 -8.05 -16.28 0.00 1.81 0.33 89.77 41.52 135.56
+41 -6.60 -17.63 0.00 2.52 -1.15 99.96 47.30 140.08
+42 -3.13 -16.05 0.00 3.27 -1.47 84.17 43.49 146.14
+43 0.76 -16.86 0.00 3.81 -1.37 75.50 33.91 158.94
+44 2.59 -9.04 0.00 5.89 -2.59 82.05 35.03 153.32
+45 2.25 -9.35 0.00 5.63 -3.66 65.35 33.35 147.54
+46 2.78 -8.99 0.17 7.78 -1.58 59.51 29.14 154.36
+47 1.04 -9.79 0.00 8.10 -2.28 48.27 23.34 147.47
+48 8.07 -6.99 0.10 10.05 -0.14 48.75 22.84 169.41
+49 5.85 -6.87 0.00 9.81 0.50 50.55 23.94 164.50
+50 5.74 -4.76 0.00 9.48 1.56 50.58 25.19 154.78
+51 4.82 -3.81 0.63 10.06 0.36 57.11 24.43 178.37
+52 7.51 -4.73 0.00 7.64 2.38 49.94 24.60 168.90
+53 8.68 -1.79 0.00 7.19 5.75 46.51 22.26 167.14
+54 8.41 -9.35 0.15 7.49 -1.00 26.91 14.34 161.69
+55 -0.12 -12.41 0.25 9.27 -0.28 43.16 18.88 165.76
+56 -2.23 -15.39 0.00 4.50 -4.24 44.79 20.82 173.74
+57 -3.58 -20.16 0.00 3.83 -1.24 44.38 21.69 182.45
+58 4.74 -9.91 0.10 4.71 -0.81 53.52 22.37 170.36
+59 9.52 -5.62 0.00 6.42 -1.04 60.10 20.80 178.84
+60 8.48 -6.21 0.00 5.58 -0.49 63.97 17.88 177.17
+61 7.43 -6.81 0.00 4.75 0.07 67.84 14.96 175.51
+62 7.62 -7.71 0.00 2.28 -0.41 65.15 24.34 192.41
+63 9.59 -8.10 0.00 2.98 1.50 56.65 24.18 203.34
+64 9.92 -5.46 0.00 4.07 1.32 61.91 20.73 198.57
+65 10.06 -3.88 0.03 4.62 1.03 67.65 22.95 170.20
+66 9.57 -2.67 0.00 3.20 0.54 99.08 27.12 192.33
+67 10.14 -5.28 0.00 2.84 4.40 99.97 21.35 199.85
+68 9.48 -6.87 0.00 5.18 1.40 51.56 21.11 199.73
+69 4.57 -10.47 0.00 3.41 1.40 50.78 19.70 212.08
+70 5.22 -9.16 0.06 3.58 -0.11 62.54 24.76 198.11
+71 7.39 -8.48 0.03 2.99 4.11 56.46 27.86 167.23
+72 6.48 -3.21 0.16 4.07 2.39 55.45 29.73 165.11
+73 3.12 -9.67 0.06 -0.63 -0.55 58.45 28.90 175.34
+74 3.92 -6.35 0.11 2.49 2.04 85.63 35.62 162.68
+75 6.94 -7.89 0.13 3.61 0.33 59.56 26.78 203.53
+76 7.35 -5.13 0.06 4.40 1.21 57.92 23.27 167.30
+77 5.98 -8.28 0.04 2.38 -0.82 61.29 30.03 193.87
+78 1.13 -9.60 1.06 -2.00 -3.47 67.48 33.88 174.78
+79 -0.92 -11.74 0.30 2.16 -4.93 71.89 34.30 194.58
+80 2.36 -10.42 0.00 4.93 -4.23 57.62 28.11 209.74
+81 2.44 -9.07 0.00 4.61 -5.36 44.03 23.28 187.04
+82 0.96 -10.67 0.05 3.76 -6.25 46.55 25.42 173.95
+83 0.87 -6.18 0.00 2.80 -6.42 67.41 33.55 180.27
+84 7.67 -5.31 0.00 2.45 -6.05 65.81 26.63 206.31
+85 10.43 -7.58 0.00 3.58 -2.47 56.89 17.48 229.14
+86 10.99 -6.15 0.00 3.00 -2.60 51.15 14.40 201.77
+87 7.31 -9.39 0.00 1.35 -0.07 47.07 23.82 211.64
+88 10.00 -7.26 0.00 2.97 -2.37 50.80 17.49 229.08
+89 11.87 -8.34 0.00 3.80 -1.68 34.97 11.90 232.16
+90 15.72 -4.49 0.00 4.62 -1.18 36.07 9.78 230.35
+91 14.84 0.13 0.00 4.75 -0.58 47.73 14.57 217.67
+92 11.92 0.12 0.06 3.88 1.93 70.53 22.95 229.55
+93 9.46 -8.27 0.00 3.96 -0.35 51.91 18.66 230.83
+94 7.31 -2.76 0.00 -0.75 1.57 57.73 17.58 171.16
+95 2.61 -4.19 0.09 -0.68 -3.81 96.20 47.36 172.95
+96 5.89 -8.29 0.06 3.28 0.50 83.58 35.84 216.06
+97 6.59 -3.89 0.00 3.96 2.03 67.42 34.88 178.43
+98 5.25 -6.96 0.00 3.60 0.24 60.27 30.46 217.21
+99 3.75 -9.55 0.00 2.08 -2.39 63.89 28.45 212.61
+100 2.20 -9.97 0.11 2.41 -0.07 57.22 29.54 207.41
+101 4.93 -12.22 0.03 2.73 -2.73 54.11 17.53 241.60
+102 12.76 -7.10 0.00 3.94 1.99 31.45 14.46 233.00
+103 12.77 2.66 0.00 5.72 4.04 38.16 12.33 191.67
+104 6.37 -2.56 0.53 4.41 -1.21 64.63 33.17 199.06
+105 5.24 -3.39 0.86 -4.18 2.20 99.97 44.78 113.21
+106 -0.03 -8.04 1.19 -3.90 0.86 79.25 61.79 143.25
+107 1.18 -12.90 0.24 -0.53 -3.43 93.69 41.35 247.94
+108 1.44 -7.06 0.04 2.05 -3.11 84.52 42.26 217.92
+109 2.82 -5.99 0.00 2.44 -3.06 98.89 42.97 216.47
+110 11.87 -5.29 0.00 4.67 -1.38 96.70 25.80 258.27
+111 12.48 -0.71 0.20 6.19 0.00 52.74 21.77 248.47
+112 11.66 -1.69 0.00 5.32 0.87 54.59 20.18 225.29
+113 10.68 0.69 0.00 6.53 3.01 40.86 20.16 248.25
+114 9.99 -4.63 0.00 4.86 1.71 53.65 20.29 222.17
+115 3.53 -7.79 0.35 3.84 -3.10 71.14 26.96 244.71
+116 5.89 -11.60 0.00 2.28 1.43 58.43 23.47 240.95
+117 7.28 0.30 0.00 3.62 1.10 59.27 29.57 230.00
+118 8.62 -7.46 0.00 3.12 -2.49 67.76 25.90 277.74
+119 12.04 -1.58 0.04 2.41 4.74 40.06 24.67 207.54
+120 11.78 0.86 0.00 4.67 1.65 70.42 26.82 225.43
+121 10.02 -4.20 0.00 4.07 -0.17 63.08 26.63 239.21
+122 10.41 -5.36 0.00 3.63 1.90 53.58 23.60 270.55
+123 11.01 -4.05 0.00 3.45 -1.37 44.76 21.55 294.79
+124 14.12 -1.29 0.06 -0.93 2.93 39.87 18.94 256.98
+125 13.92 1.50 0.00 2.53 -0.29 48.16 20.77 206.56
+126 6.96 -2.40 0.90 -1.36 1.75 71.83 36.54 202.81
+127 6.18 -1.60 1.09 2.62 -1.59 63.64 39.81 231.55
+128 2.42 -7.54 0.13 3.12 -3.19 99.97 29.86 248.95
+129 8.31 -4.07 0.00 4.71 -0.39 48.14 27.78 238.26
+130 11.59 -1.47 0.00 5.07 0.55 57.59 24.81 266.50
+131 11.22 -1.16 0.06 1.26 -0.59 50.53 25.91 240.28
+132 8.98 1.81 0.50 -2.48 3.09 60.43 28.09 200.77
+133 10.72 -1.81 0.32 3.12 1.66 54.90 26.28 292.55
+134 10.98 -1.62 0.11 -2.01 -4.19 62.71 26.74 255.87
+135 5.19 -4.44 0.83 -4.71 -0.41 76.75 33.35 221.26
+136 -0.24 -7.45 1.10 -5.54 1.90 61.54 46.22 183.91
+137 3.49 -4.55 0.42 -0.42 5.80 87.00 45.90 200.66
+138 12.26 -1.49 0.00 2.70 3.45 82.01 36.98 274.30
+139 12.82 1.88 0.00 3.40 1.84 77.13 35.10 236.68
+140 12.93 0.60 0.15 1.93 -1.68 69.41 34.83 275.95
+141 11.31 1.21 0.58 -1.47 0.22 83.30 39.40 247.80
+142 12.33 0.98 1.32 -1.46 3.27 77.58 43.03 241.73
+143 13.80 2.72 0.30 1.72 2.86 85.75 30.98 281.69
+144 15.13 1.30 0.48 1.66 2.80 60.95 26.98 289.54
+145 14.93 1.86 0.56 1.24 3.54 71.21 32.12 289.86
+146 14.90 1.45 0.44 1.67 2.34 87.28 28.96 297.24
+147 14.71 2.69 0.26 2.34 0.68 91.37 35.66 296.27
+148 15.06 4.52 0.11 1.63 -2.27 80.32 32.79 274.73
+149 14.16 3.79 1.27 0.80 -1.12 84.45 37.36 274.76
+150 10.48 1.03 0.86 2.85 -1.22 87.65 36.69 275.50
+151 17.50 2.38 0.00 3.14 3.13 71.77 23.68 292.94
+152 16.20 0.13 0.00 3.84 1.36 50.13 20.91 300.32
+153 16.60 1.67 0.00 3.82 2.63 47.36 16.35 297.57
+154 16.36 3.64 0.00 5.51 2.00 43.35 16.76 301.60
+155 15.14 -0.98 0.00 2.18 -1.84 52.70 20.27 302.33
+156 14.60 0.91 0.03 -2.25 -0.15 68.32 23.01 280.84
+157 14.77 4.14 0.17 -2.61 3.26 89.31 34.39 262.81
+158 20.08 4.20 0.00 2.32 4.23 50.53 19.17 297.52
+159 20.17 3.22 0.00 2.29 3.12 41.35 19.26 290.48
+160 21.53 5.79 0.00 4.09 4.60 33.51 14.49 302.90
+161 21.39 3.60 0.00 3.62 -0.72 37.76 13.34 305.32
+162 17.18 2.93 0.21 -2.25 1.78 48.73 17.70 288.03
+163 14.15 0.83 2.83 -3.75 -2.53 74.59 32.75 240.87
+164 13.75 -0.32 0.00 -0.72 -1.41 94.01 27.45 300.72
+165 16.82 -0.26 0.05 2.25 2.74 62.33 20.74 305.96
+166 21.31 3.94 0.00 3.21 2.37 40.07 17.50 302.26
+167 20.95 4.50 0.00 1.92 1.32 52.19 18.61 288.10
+168 20.96 4.27 0.00 2.51 0.97 47.27 16.48 298.06
+169 20.70 4.15 0.00 1.84 -2.85 44.04 17.24 298.61
+170 20.85 6.52 0.00 0.71 2.23 49.40 19.01 279.59
+171 20.04 5.98 0.19 -1.06 1.41 56.45 26.70 278.99
+172 20.42 7.57 0.00 0.72 3.27 68.80 25.17 289.00
+173 23.63 8.49 0.04 3.33 2.59 46.36 15.45 286.01
+174 23.20 7.17 0.00 4.08 2.05 43.16 13.81 286.75
+175 23.18 5.62 0.00 4.07 0.74 31.77 13.01 299.18
+176 22.75 5.27 0.00 4.01 -0.49 36.78 14.20 303.47
+177 21.91 4.24 0.00 2.97 -0.20 50.02 16.97 305.43
+178 21.85 7.13 0.00 4.25 4.13 27.25 13.36 303.61
+179 21.22 4.95 0.03 3.05 1.84 36.03 14.24 298.84
+180 20.55 6.31 0.17 1.28 2.71 50.10 19.91 273.64
+181 19.57 5.95 0.11 2.70 2.35 70.70 22.54 279.16
+182 20.55 7.11 0.08 3.26 -0.14 59.18 22.05 282.12
+183 21.25 6.87 0.00 2.91 -1.31 43.82 16.79 288.43
+184 22.50 4.83 0.00 1.61 1.12 43.45 16.70 294.69
+185 23.78 4.62 0.04 1.58 0.72 41.29 14.37 291.33
+186 25.39 7.57 0.00 2.09 1.74 43.98 15.42 292.71
+187 26.02 8.85 0.00 2.66 2.00 35.27 14.83 286.91
+188 25.60 8.96 0.12 2.78 0.91 39.13 16.60 277.59
+189 25.53 9.42 0.00 2.55 1.71 44.46 16.76 299.76
+190 25.30 9.14 0.08 1.96 2.78 38.10 18.23 295.12
+191 23.38 8.19 0.10 1.16 3.63 36.72 18.70 286.02
+192 22.54 10.08 0.31 3.44 4.82 48.48 20.68 281.61
+193 20.00 8.46 1.33 3.56 3.54 74.09 25.76 270.26
+194 18.57 8.33 0.72 2.63 0.61 75.44 31.67 271.64
+195 19.93 7.37 0.94 2.50 3.12 74.82 28.64 281.95
+196 18.03 7.29 1.14 2.38 3.39 84.72 31.82 250.04
+197 20.81 7.00 0.81 3.59 0.84 99.91 26.07 280.92
+198 21.91 5.81 0.00 5.34 0.79 42.11 14.58 291.94
+199 21.29 3.70 0.05 3.44 -1.45 37.95 14.87 291.79
+200 20.38 4.42 0.25 0.94 -0.89 48.25 18.92 279.13
+201 20.55 6.38 0.72 2.12 -1.01 47.84 21.37 266.10
+202 19.97 7.06 0.86 3.46 -0.19 46.50 23.25 252.43
+203 18.98 6.53 0.61 3.52 -0.74 55.31 25.50 263.29
+204 18.09 6.36 1.18 2.28 -1.22 75.10 39.47 263.61
+205 17.18 6.65 1.05 2.24 0.92 79.06 34.53 255.76
+206 16.73 5.70 0.66 2.38 3.54 92.04 32.52 255.20
+207 15.57 3.17 0.86 1.57 4.15 92.63 35.27 172.37
+208 13.60 3.82 1.07 2.21 3.46 99.98 49.06 212.20
+209 15.98 4.51 0.72 3.08 1.97 99.96 40.37 244.73
+210 17.08 3.17 0.00 3.45 0.51 91.65 34.52 251.73
+211 17.58 3.86 0.11 3.46 -0.13 76.21 32.65 249.90
+212 17.33 5.14 0.17 3.16 -1.42 83.64 35.76 238.46
+213 17.56 5.22 0.55 2.74 -1.66 99.95 37.30 262.74
+214 17.68 6.17 1.12 2.08 -0.09 95.89 38.87 229.10
+215 16.75 7.55 0.50 2.25 2.34 94.19 43.92 228.92
+216 17.67 7.19 0.46 2.66 2.75 99.95 36.81 225.18
+217 18.39 5.29 0.07 2.95 1.77 83.75 34.85 234.15
+218 19.07 4.74 0.18 3.19 0.75 77.60 32.33 255.75
+219 19.52 3.56 0.53 2.10 -1.19 70.06 28.54 265.60
+220 19.17 4.26 0.00 -1.47 -0.68 81.61 31.23 251.55
+221 18.62 5.77 0.31 0.13 2.83 99.94 35.45 266.45
+222 21.72 5.85 0.00 2.24 1.22 64.48 21.81 277.95
+223 23.11 4.63 0.00 2.91 -0.51 42.25 14.90 279.35
+224 22.79 5.22 0.00 2.56 -0.71 29.59 13.26 260.86
+225 21.51 8.10 0.00 -1.48 -0.52 50.93 19.65 235.06
+226 21.61 7.35 0.00 0.54 3.81 77.47 27.83 252.65
+227 22.36 7.29 0.09 2.93 1.33 59.84 22.50 265.12
+228 21.83 5.30 0.00 2.00 -0.12 63.47 23.75 256.03
+229 21.71 5.50 0.28 1.51 2.60 80.32 24.64 252.98
+230 21.95 7.36 0.07 2.83 2.53 64.62 25.93 255.10
+231 20.24 7.53 0.35 2.81 2.20 74.08 30.19 245.86
+232 19.96 7.37 0.83 3.54 1.89 73.67 30.39 260.17
+233 19.69 7.88 0.59 2.81 -0.32 72.34 32.92 238.86
+234 17.96 7.73 0.63 0.94 -2.85 93.64 37.41 235.31
+235 14.70 6.62 1.31 -1.99 -0.62 89.60 43.15 215.83
+236 18.89 6.36 0.77 1.93 -0.28 84.40 27.56 235.41
+237 19.56 3.48 0.04 3.71 0.27 57.03 23.88 247.45
+238 18.73 2.62 0.00 3.03 -1.47 61.25 23.28 241.69
+239 19.62 2.81 0.00 2.65 0.30 50.86 21.52 263.11
+240 20.03 3.22 0.00 3.34 -0.46 48.23 21.21 262.55
+241 19.16 7.30 0.00 3.78 4.16 39.22 20.85 236.62
+242 19.54 6.98 0.00 3.15 5.15 60.16 21.24 229.18
+243 18.10 3.86 0.00 3.78 4.44 52.90 22.89 242.80
+244 14.91 -0.23 0.09 2.45 -1.13 57.06 24.91 248.03
+245 14.49 0.20 0.21 -1.73 -1.18 61.37 30.32 241.79
+246 15.19 0.37 0.85 0.08 0.25 67.63 33.24 224.70
+247 15.23 4.20 2.02 0.36 -1.34 69.84 31.75 218.28
+248 15.68 2.91 0.00 7.02 -1.11 63.49 28.14 236.00
+249 14.37 -0.36 0.00 2.42 -1.64 68.15 30.65 189.86
+250 15.99 0.22 0.00 2.11 0.05 93.76 28.23 247.63
+251 19.10 3.57 0.00 3.02 3.25 58.91 24.86 244.03
+252 18.99 1.84 0.00 3.35 -1.14 50.05 24.31 246.89
+253 19.25 2.35 0.00 1.37 2.45 53.63 22.52 245.86
+254 19.59 5.91 0.00 2.30 3.38 56.80 24.20 227.63
+255 20.05 4.82 0.00 2.84 1.68 61.43 25.05 242.81
+256 19.91 5.21 0.06 3.09 2.17 57.56 24.19 240.92
+257 19.20 5.99 0.09 4.18 2.88 56.53 22.96 226.35
+258 15.44 0.90 0.35 2.32 0.71 66.47 28.35 203.15
+259 8.77 -4.05 0.27 1.52 -4.87 63.81 29.14 211.29
+260 12.44 -5.14 0.00 2.39 1.88 79.19 25.45 240.99
+261 12.74 0.52 0.00 3.24 2.87 67.88 28.35 193.59
+262 15.04 1.65 0.00 3.95 -1.60 76.94 26.72 231.36
+263 17.08 1.55 0.04 2.96 0.94 60.12 26.84 223.20
+264 17.24 3.69 0.00 3.97 0.20 62.36 26.62 205.51
+265 17.60 4.83 0.00 3.74 0.88 73.63 25.93 190.80
+266 13.82 3.49 0.24 3.82 0.00 84.67 33.21 198.75
+267 10.51 -3.05 0.00 0.84 -1.21 70.69 32.72 208.02
+268 11.87 -0.08 0.22 0.96 1.68 71.86 32.19 204.14
+269 14.00 0.50 0.06 1.69 2.20 98.21 31.31 211.54
+270 14.51 3.69 0.33 2.42 2.46 83.81 30.97 194.78
+271 16.67 3.76 0.10 3.12 3.10 69.11 27.08 208.06
+272 16.57 3.75 0.00 4.32 1.49 56.14 24.53 195.78
+273 13.47 -1.93 0.31 2.90 -0.87 78.28 27.43 158.74
+274 1.11 -10.34 1.34 -3.02 -4.31 77.82 38.39 203.05
+275 1.88 -10.70 0.00 2.17 2.36 76.76 34.25 200.86
+276 3.78 -3.82 0.57 2.57 5.59 78.20 34.05 131.38
+277 6.19 -1.97 0.26 3.98 5.50 99.95 50.16 165.34
+278 5.65 -6.05 0.10 5.47 -0.05 84.45 33.33 205.43
+279 5.92 -1.87 1.32 3.31 2.81 77.75 34.72 170.81
+280 6.79 -4.77 0.00 5.49 0.05 78.51 35.12 209.40
+281 10.24 -2.44 0.00 4.31 2.65 99.90 35.66 203.87
+282 10.51 -0.31 0.00 3.58 3.09 77.66 31.06 191.61
+283 10.50 0.22 0.00 5.56 1.15 68.42 28.16 199.32
+284 8.93 -0.02 0.52 3.10 5.04 99.88 30.35 125.12
+285 7.56 -4.97 0.17 9.97 2.09 82.29 30.10 187.20
+286 5.08 -6.74 0.04 7.44 0.18 64.87 32.80 169.79
+287 5.73 -2.59 1.02 5.01 0.28 99.93 38.47 150.71
+288 1.17 -12.14 0.34 2.51 -4.76 73.25 40.21 160.58
+289 -4.53 -14.71 0.06 3.24 -3.62 56.15 31.91 178.39
+290 0.64 -10.37 0.00 4.35 -0.95 66.80 34.62 132.68
+291 0.85 -6.05 0.00 4.39 -2.35 99.95 40.25 152.46
+292 2.45 -4.41 0.00 4.68 -1.49 99.95 44.11 135.46
+293 3.95 -4.45 0.00 4.31 -1.46 82.59 47.86 144.83
+294 5.13 -3.68 0.00 3.26 -0.92 79.62 47.52 145.86
+295 8.73 -4.12 0.00 3.99 -0.37 88.70 38.90 167.97
+296 7.66 -0.98 0.03 4.52 -2.29 89.73 31.08 170.80
+297 9.01 -3.16 0.00 5.70 -2.07 73.59 30.34 166.00
+298 9.11 -2.95 0.35 5.25 -0.92 74.36 33.64 144.77
+299 7.70 -1.85 0.53 8.05 0.55 60.61 31.34 154.72
+300 4.13 -8.76 0.04 1.58 -0.21 62.88 31.88 145.58
+301 -0.49 -11.01 0.53 2.15 0.44 74.56 31.20 171.71
+302 -2.82 -11.27 0.18 -1.44 4.15 50.51 32.61 114.87
+303 -2.54 -15.24 1.26 -4.61 -2.15 92.82 40.60 113.98
+304 -8.61 -20.93 0.28 2.51 -2.92 92.73 43.36 146.68
+305 -5.15 -17.46 0.00 2.59 -2.11 93.63 43.35 154.19
+306 -3.39 -13.66 0.05 2.51 -1.21 95.97 48.13 136.35
+307 2.16 -11.03 0.00 4.02 -2.36 92.15 48.80 151.39
+308 2.90 -8.20 0.00 3.65 -3.57 94.87 40.11 154.84
+309 6.76 -6.73 0.00 3.96 -0.98 99.93 35.19 155.93
+310 6.54 -2.24 0.03 4.92 1.10 99.94 45.35 125.77
+311 6.17 -3.40 0.15 5.70 -1.70 71.79 39.48 133.79
+312 1.96 -5.40 0.00 3.54 -1.30 71.78 38.24 130.67
+313 1.67 -5.04 0.05 4.51 -1.95 69.47 41.11 129.80
+314 1.59 -6.45 0.00 4.65 -2.34 69.20 36.66 122.47
+315 3.51 -3.75 0.00 7.33 -0.87 82.02 43.12 126.14
+316 2.20 -11.53 0.00 2.54 -3.05 81.56 27.32 130.49
+317 1.13 -13.66 0.00 3.78 0.26 50.53 20.45 143.31
+318 4.62 -8.35 0.00 3.92 0.55 49.05 18.20 127.42
+319 1.48 -10.90 0.05 2.40 -0.06 97.06 24.77 118.19
+320 1.37 -12.88 0.00 4.69 -0.82 53.15 19.92 140.39
+321 0.73 -9.23 0.00 7.28 -0.68 52.10 20.16 119.02
+322 -1.53 -12.73 0.04 3.47 3.68 67.75 20.09 95.61
+323 -2.95 -16.72 0.15 4.56 1.68 70.14 28.74 118.75
+324 -9.60 -19.83 0.10 2.89 2.88 52.61 26.38 124.83
+325 -6.69 -16.65 2.19 -4.02 -1.18 85.33 31.24 83.99
+326 -5.23 -22.59 0.00 3.34 0.11 95.97 32.41 136.64
+327 2.12 -14.27 0.00 7.58 -1.34 68.10 40.37 123.78
+328 4.32 -5.05 0.00 8.41 0.04 80.10 50.45 116.83
+329 4.04 -3.98 0.06 8.92 0.28 95.44 50.87 112.90
+330 2.04 -15.27 0.19 4.14 -4.04 64.80 37.93 111.99
+331 -6.79 -17.15 0.05 2.34 -2.04 58.06 31.37 128.19
+332 5.53 -12.00 0.52 4.97 -0.16 76.69 27.60 107.99
+333 4.68 -9.62 0.00 4.77 -6.75 69.96 44.49 101.29
+334 2.68 -7.32 0.00 4.59 -4.04 99.96 49.90 102.05
+335 6.33 -7.37 0.09 5.37 -2.84 91.36 33.50 122.83
+336 5.47 -4.72 0.00 5.53 -1.77 100.00 41.15 113.01
+337 4.78 -8.22 0.12 3.75 -2.08 68.59 46.11 101.73
+338 0.22 -13.33 0.00 3.02 -0.15 70.82 44.38 121.16
+339 -1.37 -10.98 0.00 4.22 -0.69 79.76 46.30 100.77
+340 -4.10 -11.58 0.00 2.45 -1.01 76.00 38.84 102.91
+341 -0.87 -8.93 0.40 4.79 -1.13 99.94 36.64 107.22
+342 -7.80 -18.97 0.00 2.87 -3.26 57.40 29.87 119.57
+343 -5.97 -15.37 0.00 3.92 -1.19 67.04 34.75 116.91
+344 -4.40 -13.50 0.00 3.87 -0.26 62.28 29.82 109.39
+345 -5.17 -12.14 0.05 2.66 1.44 78.87 36.12 98.29
+346 -6.15 -14.34 0.05 0.87 -0.77 99.98 49.12 84.88
+347 -7.68 -16.15 0.11 -0.02 0.41 99.95 43.92 81.65
+348 -6.25 -11.53 0.09 0.97 0.95 99.97 55.85 67.86
+349 -1.69 -15.38 0.03 3.39 0.48 90.24 52.18 98.56
+350 -0.27 -10.50 0.15 5.64 2.54 88.10 34.30 102.62
+351 1.75 -5.46 0.00 4.79 5.35 99.95 39.92 103.33
+352 -0.58 -9.89 0.11 3.19 2.87 94.12 53.09 95.10
+353 -6.38 -18.08 0.15 3.71 0.36 79.46 36.87 104.17
+354 -9.20 -21.47 0.00 4.14 0.44 96.44 34.29 103.84
+355 -3.06 -16.68 0.00 6.15 0.23 66.53 30.14 104.52
+356 2.13 -11.09 0.18 7.12 2.67 62.62 46.70 98.43
+357 3.06 -6.76 0.67 5.84 2.13 68.85 54.56 85.75
+358 -3.86 -14.60 0.00 3.38 0.14 86.90 53.28 98.67
+359 -11.69 -19.89 0.00 4.90 -0.87 63.48 39.97 103.73
+360 -6.92 -18.86 0.07 4.37 1.39 96.78 43.39 75.57
+361 2.65 -10.15 0.29 4.14 2.82 83.35 45.77 103.53
+362 2.34 -7.83 1.74 3.97 1.60 86.71 39.07 103.28
+363 -3.74 -17.65 0.05 3.52 -0.07 87.66 41.68 101.19
+364 2.77 -9.81 0.25 4.51 3.99 99.94 57.96 93.45
+365 -2.36 -8.74 0.58 4.01 2.44 99.99 59.92 69.89
+366 4.79 -2.78 0.30 4.88 1.74 99.99 47.89 95.32
diff --git a/inst/extdata/example1/Input/data_weather_maca/weath.1981 b/inst/extdata/example1/Input/data_weather_maca/weath.1981
new file mode 100644
index 00000000..f6e32d99
--- /dev/null
+++ b/inst/extdata/example1/Input/data_weather_maca/weath.1981
@@ -0,0 +1,367 @@
+# weather for site maca example at -105.58 / 39.59 year = 1981
+# DOY, Tmax_C, Tmin_C, PPT_cm, uas_mPERs, vas_mPERs, hursmax_pct, hursmin_pct, rsds_WPERm2
+1 2.90 -12.88 0.17 4.07 -3.74 88.60 32.34 104.99
+2 -6.43 -16.16 0.00 2.59 -3.29 63.83 32.60 109.03
+3 2.30 -12.13 0.00 4.66 -1.15 65.00 33.60 111.17
+4 1.95 -8.65 0.00 4.40 -1.64 99.99 41.51 101.51
+5 0.98 -8.11 0.12 4.70 -0.19 99.97 49.00 98.79
+6 1.62 -14.39 0.21 1.22 -3.08 99.94 54.40 99.31
+7 -4.83 -18.65 0.00 1.76 -0.54 65.20 33.42 113.70
+8 -0.32 -13.61 0.00 3.95 0.21 44.81 30.79 107.55
+9 -0.42 -10.01 0.00 3.80 -2.00 74.80 34.04 92.42
+10 1.53 -9.85 0.00 3.74 -1.49 74.50 47.42 103.25
+11 2.58 -6.74 0.06 4.80 0.48 89.98 51.25 97.47
+12 0.37 -9.88 0.16 1.96 -0.25 81.39 53.99 83.66
+13 -5.22 -14.55 0.00 1.30 -1.94 95.15 46.71 82.04
+14 -6.54 -14.96 0.21 -2.16 -1.05 99.91 57.94 60.66
+15 -6.70 -11.84 0.76 -4.51 2.89 79.44 61.15 60.21
+16 -5.76 -13.43 0.19 1.91 -0.18 73.35 54.25 98.41
+17 -4.17 -16.20 0.06 3.54 -0.50 78.86 54.93 109.54
+18 -1.60 -10.32 0.07 3.92 0.00 85.08 62.21 97.12
+19 -1.56 -10.35 0.00 2.89 0.00 73.25 62.06 99.38
+20 -2.43 -12.25 0.00 3.39 -1.07 99.97 56.13 101.14
+21 -4.03 -14.94 0.05 2.32 -2.07 76.63 55.38 103.79
+22 -4.94 -19.71 0.00 4.52 -1.17 84.26 42.61 131.63
+23 -5.94 -16.07 0.00 2.37 0.08 92.20 48.92 102.61
+24 -7.95 -20.08 0.21 -0.15 -2.80 99.93 39.81 133.23
+25 -5.35 -18.43 0.00 5.11 -1.83 99.89 51.35 101.46
+26 -4.70 -11.85 0.06 4.68 -1.41 80.42 47.29 104.60
+27 -4.72 -14.74 0.13 4.17 0.12 99.98 54.47 98.46
+28 -6.21 -13.98 0.15 -1.49 2.08 99.98 85.69 89.02
+29 -5.81 -14.60 0.50 -0.90 2.25 99.98 68.79 84.89
+30 -5.27 -13.77 0.00 2.54 0.96 98.46 56.65 106.18
+31 -9.36 -20.87 0.18 2.43 -1.27 87.29 50.49 134.22
+32 -11.09 -25.22 0.21 3.07 -0.18 83.73 39.95 149.11
+33 -10.14 -25.62 0.11 3.42 -0.16 86.70 47.54 143.34
+34 -8.91 -19.27 0.00 3.64 -2.19 77.51 53.03 131.14
+35 -2.64 -18.55 0.00 4.56 -1.83 78.78 32.63 153.88
+36 0.26 -12.87 0.00 5.63 -2.18 99.96 41.71 138.21
+37 0.36 -11.11 0.00 4.44 -2.23 73.60 52.51 133.10
+38 0.09 -12.22 0.00 3.72 -2.06 99.99 55.10 157.37
+39 0.29 -7.92 0.00 4.34 -2.20 93.95 58.76 129.11
+40 1.17 -7.93 0.03 3.98 -0.80 82.75 56.89 135.44
+41 2.27 -8.60 0.00 3.75 0.59 96.06 52.77 134.98
+42 1.40 -6.41 0.23 2.72 3.23 99.98 68.53 108.44
+43 -0.17 -9.80 0.25 1.65 0.13 99.99 54.09 114.70
+44 -2.27 -17.11 0.44 1.36 -1.94 88.64 35.22 156.53
+45 -1.58 -15.77 0.12 2.63 -0.53 90.13 39.08 150.79
+46 -0.26 -15.45 0.00 3.21 -1.88 65.77 35.94 170.87
+47 2.45 -12.47 0.00 3.50 -1.20 65.08 36.39 164.91
+48 4.16 -11.12 0.00 3.11 -1.17 77.01 41.61 179.35
+49 5.43 -9.77 0.00 3.38 0.86 70.36 32.71 179.58
+50 6.05 -9.40 0.03 2.50 2.09 99.99 33.85 183.91
+51 4.49 -8.35 0.00 -1.06 1.53 73.63 44.41 151.69
+52 1.99 -7.02 0.18 0.12 3.20 77.69 55.04 133.84
+53 1.62 -7.59 0.19 2.24 0.54 90.89 52.30 143.58
+54 0.85 -7.87 0.08 1.72 1.49 95.84 54.82 133.50
+55 0.55 -6.98 0.49 1.81 -0.18 83.03 78.07 129.79
+56 0.48 -10.66 0.00 1.15 1.38 82.24 53.50 151.23
+57 0.14 -7.63 0.22 0.37 2.90 99.98 55.33 115.48
+58 0.13 -6.99 1.52 -1.84 4.56 100.00 85.69 114.19
+59 -0.74 -11.35 0.20 3.98 1.10 77.41 48.67 147.77
+60 -1.68 -11.54 0.24 3.39 -2.07 99.98 46.72 160.69
+61 -0.83 -10.92 0.25 -2.21 2.17 99.99 48.90 145.82
+62 1.69 -8.51 0.71 1.81 2.53 100.00 57.51 151.62
+63 2.57 -6.08 0.22 3.67 0.15 98.03 56.28 164.52
+64 2.75 -5.82 0.00 2.12 -2.94 81.34 50.59 165.42
+65 1.61 -10.95 0.06 1.93 -4.37 99.99 43.36 180.53
+66 5.35 -9.59 0.06 3.44 -0.32 69.98 36.89 207.11
+67 4.60 -4.23 0.04 4.43 0.63 75.43 45.40 162.41
+68 5.83 -3.61 0.00 4.31 -0.54 92.95 44.51 175.52
+69 5.61 -3.38 0.00 3.88 1.49 87.00 51.25 167.17
+70 4.42 -5.81 1.05 1.24 -2.23 78.67 55.13 133.28
+71 0.51 -9.94 0.32 0.36 -4.87 99.14 45.83 167.32
+72 1.85 -11.86 0.07 2.04 -2.46 75.46 31.94 197.06
+73 3.87 -8.39 0.00 2.75 1.95 82.26 31.98 191.94
+74 5.55 -4.03 0.00 4.11 3.35 70.50 44.84 168.95
+75 5.46 -4.45 0.09 3.47 2.97 89.16 43.74 190.09
+76 4.11 -7.66 0.83 -0.99 -2.34 96.31 47.29 177.58
+77 0.57 -9.01 0.31 -3.58 -4.36 100.00 51.87 169.33
+78 3.83 -9.44 0.25 -1.27 -2.26 99.98 30.81 223.03
+79 7.95 -8.10 0.00 1.31 -0.97 99.97 25.33 228.57
+80 7.93 -6.43 0.00 2.43 -0.06 64.64 30.25 202.61
+81 3.69 -5.95 1.06 -2.65 0.22 99.47 45.89 103.77
+82 0.30 -7.73 1.81 -4.24 -4.21 99.98 61.45 101.88
+83 1.25 -11.37 0.15 -0.35 -4.03 99.95 39.06 220.58
+84 5.44 -11.04 0.00 3.21 0.54 72.21 31.94 220.39
+85 7.20 -5.17 0.03 4.92 -0.97 77.22 32.17 225.37
+86 9.69 -3.85 0.00 4.23 0.92 76.91 35.11 198.88
+87 10.96 -3.32 0.00 3.85 1.38 83.90 31.54 212.84
+88 9.48 -0.96 0.00 4.04 4.38 99.21 31.99 193.17
+89 7.34 -8.20 0.00 4.70 -2.35 99.95 28.85 206.45
+90 5.32 -9.09 0.00 3.87 1.40 55.86 22.73 201.77
+91 2.66 -9.25 0.16 3.38 -2.74 71.78 29.38 221.25
+92 2.20 -13.17 0.17 1.59 -2.89 64.61 21.35 237.62
+93 10.52 -10.45 0.00 2.94 2.28 40.98 17.37 237.39
+94 11.58 -2.86 0.00 4.39 2.34 43.53 20.49 219.36
+95 11.10 -5.32 0.00 2.95 2.27 56.64 21.38 217.78
+96 10.57 -3.91 0.00 3.04 0.11 52.50 23.26 222.01
+97 6.12 -9.47 0.29 1.53 -6.34 67.48 22.46 213.73
+98 7.27 -10.87 0.00 -2.01 -5.02 36.89 17.97 240.94
+99 11.72 -8.85 0.00 1.68 -0.31 36.07 12.98 239.67
+100 13.91 -1.75 0.06 5.03 0.40 31.61 13.25 243.65
+101 12.60 -4.39 0.05 1.02 0.24 39.88 13.69 204.56
+102 9.56 -1.44 0.25 -1.78 3.13 56.94 23.16 200.78
+103 8.53 -2.66 0.94 2.05 1.38 99.95 37.69 195.46
+104 7.10 -2.09 0.04 2.83 -2.20 90.15 39.93 222.33
+105 7.76 -6.15 0.00 1.39 0.24 86.07 37.82 207.58
+106 11.12 0.79 0.00 3.70 2.38 80.58 31.34 223.34
+107 10.02 -0.51 0.86 1.75 4.01 59.05 33.61 216.43
+108 7.89 -5.14 3.96 -0.99 3.09 91.52 47.62 195.66
+109 3.50 -6.19 2.49 -4.42 -4.81 93.45 56.34 155.51
+110 -1.40 -10.51 1.25 -1.25 -4.40 83.90 57.10 179.36
+111 -3.85 -12.27 0.87 -1.43 0.06 93.41 54.48 180.48
+112 -2.83 -9.97 1.17 -4.24 0.64 90.17 60.03 150.89
+113 -1.22 -9.57 2.02 -3.43 -1.12 99.99 57.68 183.64
+114 0.57 -7.34 0.12 0.28 2.35 90.27 48.02 193.39
+115 2.45 -6.83 0.62 2.57 4.29 81.14 46.99 186.16
+116 4.00 -1.62 0.49 2.69 1.10 79.73 54.03 206.17
+117 3.92 -6.69 0.87 -1.75 -0.94 99.97 51.16 180.44
+118 1.90 -5.09 0.44 -1.31 0.91 74.26 40.45 201.88
+119 4.44 -7.18 0.05 -0.88 1.92 81.94 33.37 234.72
+120 7.56 -5.28 0.20 2.39 0.19 79.35 32.05 236.87
+121 7.00 -5.76 0.04 2.94 1.24 77.87 29.40 274.05
+122 6.32 -2.16 0.10 2.79 2.06 76.41 29.72 200.65
+123 11.50 -2.97 0.00 2.44 2.25 75.98 30.52 241.68
+124 12.42 -2.38 0.00 3.40 1.04 77.47 26.48 265.14
+125 12.05 0.74 0.05 4.54 1.85 60.01 24.79 263.77
+126 9.08 -4.97 0.00 3.12 -4.82 70.54 25.52 289.76
+127 6.11 -8.32 0.00 1.67 -3.14 53.72 20.10 300.58
+128 12.56 -0.93 0.00 2.00 5.18 38.99 19.73 246.11
+129 13.90 -1.31 0.00 2.84 -0.94 45.69 20.29 297.98
+130 15.69 -0.98 0.00 0.64 3.70 45.39 17.89 288.32
+131 14.98 0.95 0.04 3.83 -0.25 41.80 17.61 269.97
+132 11.31 -3.90 0.07 1.83 -4.06 56.67 20.91 301.79
+133 15.82 -0.71 0.00 1.91 4.03 40.95 18.85 296.48
+134 18.91 4.95 0.07 5.06 6.90 41.96 18.63 292.57
+135 16.50 4.35 0.05 4.51 6.00 47.35 19.09 251.39
+136 15.00 2.36 0.00 4.11 6.10 42.39 17.72 292.02
+137 13.21 -1.02 0.39 2.78 -0.60 67.61 23.48 268.24
+138 8.81 -1.92 0.75 1.84 -4.17 86.84 28.96 275.06
+139 13.80 -2.11 0.00 2.54 3.52 55.95 22.77 295.07
+140 14.32 2.94 0.17 3.45 8.65 43.46 21.97 285.40
+141 16.75 1.12 0.05 2.91 5.20 46.79 14.45 299.76
+142 16.16 2.22 0.00 2.85 6.12 30.58 14.27 283.07
+143 14.32 -0.87 0.06 4.64 2.17 37.16 15.43 297.72
+144 12.75 -1.08 0.00 5.87 -1.46 49.88 17.41 276.55
+145 9.86 -1.50 0.00 -0.33 0.18 65.05 28.13 239.92
+146 8.94 0.53 0.21 -1.75 4.83 70.38 35.28 235.95
+147 12.83 -1.17 0.27 2.62 2.21 72.24 30.40 290.73
+148 15.49 2.23 0.00 3.04 5.12 54.62 17.63 298.27
+149 16.48 -1.91 0.00 4.49 2.54 43.54 15.94 301.62
+150 16.33 0.63 0.00 3.84 -0.93 47.06 16.79 292.77
+151 14.16 0.97 0.00 1.41 -1.93 39.48 17.54 299.03
+152 15.95 -0.21 0.00 -0.09 2.49 51.64 17.52 296.49
+153 19.04 0.92 0.00 3.04 1.58 38.59 12.16 305.13
+154 19.36 6.92 0.00 5.51 -1.22 28.65 12.80 301.75
+155 16.98 0.68 0.00 1.97 -1.58 41.01 17.77 288.90
+156 15.08 4.76 0.00 0.51 2.27 54.22 20.03 244.20
+157 11.57 1.15 0.92 -1.19 -0.46 88.18 32.79 285.28
+158 10.98 -0.66 0.30 -1.07 2.09 75.93 28.24 287.79
+159 14.15 -1.14 0.16 2.64 2.66 67.73 25.37 293.53
+160 16.31 4.69 1.68 2.92 3.16 69.57 23.91 280.07
+161 18.76 3.35 0.00 2.63 0.30 57.16 22.82 300.21
+162 18.89 3.98 0.00 1.66 -1.02 56.01 25.24 299.63
+163 21.40 4.46 0.00 1.82 2.41 51.39 18.11 302.53
+164 22.15 4.33 0.00 4.01 1.61 41.14 14.63 303.55
+165 21.91 3.73 0.00 1.80 -1.86 36.99 15.47 301.13
+166 23.47 5.79 0.00 -1.98 2.01 40.40 15.78 299.99
+167 22.94 5.13 0.00 0.73 1.99 47.61 16.10 299.03
+168 22.58 5.04 0.00 1.27 -1.67 49.15 19.23 300.31
+169 19.46 5.35 0.22 -1.79 -0.55 76.22 25.20 284.14
+170 18.77 4.41 0.07 1.16 4.20 69.86 24.39 293.74
+171 21.64 7.21 0.04 2.59 4.98 66.53 18.87 291.92
+172 24.43 7.34 0.00 3.48 4.50 39.16 12.04 305.69
+173 23.85 4.91 0.00 4.44 1.21 30.64 11.81 304.19
+174 23.74 5.83 0.00 3.69 2.22 29.65 11.99 305.82
+175 24.63 4.80 0.00 4.43 0.99 28.57 10.12 306.28
+176 24.02 6.36 0.00 4.67 1.48 20.96 9.92 303.15
+177 23.90 6.64 0.00 3.61 2.60 28.23 11.74 301.29
+178 23.64 8.66 0.08 3.18 3.05 39.22 14.57 292.22
+179 21.59 8.62 0.00 3.45 2.74 56.86 20.91 297.59
+180 20.53 8.26 0.03 3.63 -0.10 58.00 23.23 273.07
+181 20.43 7.35 0.14 2.31 -2.88 66.37 24.24 257.92
+182 20.06 5.14 0.22 0.90 -1.28 64.22 21.70 277.20
+183 19.38 6.13 0.15 1.65 2.03 67.22 23.33 271.60
+184 21.12 5.58 0.81 0.56 1.27 73.75 22.31 289.26
+185 23.69 5.92 0.08 1.55 0.50 50.05 15.05 292.78
+186 24.07 8.08 0.00 1.20 2.48 40.75 15.00 280.41
+187 23.64 8.11 0.00 2.86 0.12 45.14 19.23 299.63
+188 26.29 7.37 0.00 1.86 0.53 50.73 13.02 300.39
+189 25.82 8.41 0.00 3.51 -1.22 28.68 12.50 300.32
+190 19.93 4.31 0.08 -1.16 -3.46 46.21 13.68 282.24
+191 19.76 5.26 0.15 -2.45 0.04 76.10 28.41 263.14
+192 21.61 6.34 0.00 1.33 0.89 60.06 21.45 291.95
+193 21.92 6.77 0.28 0.84 -3.65 63.03 22.61 257.41
+194 15.45 -0.75 0.46 -1.94 -0.94 87.81 28.43 277.17
+195 14.77 2.57 0.17 0.82 4.88 99.99 30.99 233.42
+196 21.26 5.14 0.00 2.21 2.13 71.05 22.48 285.15
+197 21.25 5.29 0.00 4.46 -0.89 41.99 18.01 288.23
+198 21.17 5.44 0.00 4.19 -0.42 35.36 17.73 292.19
+199 21.11 4.36 0.00 2.20 -0.31 45.02 16.79 266.96
+200 21.46 8.47 0.00 2.29 1.99 44.03 20.01 256.22
+201 21.37 9.55 0.00 3.07 0.67 49.56 23.90 262.61
+202 21.46 8.54 0.35 2.74 0.36 58.98 25.32 258.91
+203 22.04 8.94 0.06 3.10 1.36 63.21 24.64 275.95
+204 22.49 9.42 0.41 3.14 1.83 54.60 21.86 269.86
+205 22.02 9.64 0.06 4.81 1.77 37.71 19.62 286.15
+206 21.52 5.11 0.09 3.51 0.28 39.33 18.98 285.67
+207 21.15 4.29 0.06 2.11 2.05 44.31 19.57 264.61
+208 21.65 8.78 0.14 3.53 2.12 54.17 23.93 272.28
+209 20.93 8.01 0.06 2.67 -0.03 53.34 26.21 269.15
+210 20.12 8.58 0.25 2.55 1.32 78.53 31.11 264.52
+211 18.91 9.01 0.79 1.88 -0.19 88.60 36.38 248.69
+212 19.12 7.51 1.11 -0.18 2.65 85.61 39.60 248.94
+213 19.60 8.19 0.67 2.51 1.53 85.33 38.89 259.98
+214 18.98 8.37 1.13 2.29 1.56 79.18 35.76 247.00
+215 18.97 6.92 0.55 1.93 -0.13 85.38 36.10 257.48
+216 19.53 6.72 0.64 2.93 0.89 83.98 33.20 263.95
+217 19.53 6.85 1.16 2.19 -2.23 85.09 39.34 211.57
+218 12.65 3.05 0.82 -1.72 -3.82 99.99 54.63 156.85
+219 12.40 1.67 0.50 1.10 -1.88 96.23 45.37 242.89
+220 17.08 2.84 0.00 1.81 1.24 96.85 35.63 263.87
+221 20.12 4.31 0.08 2.64 1.19 94.96 32.00 277.19
+222 19.62 6.95 0.03 2.08 0.39 85.75 33.11 237.05
+223 20.31 7.02 0.08 2.39 0.38 80.45 30.14 256.75
+224 20.87 5.54 0.00 2.50 -1.69 68.70 27.66 262.90
+225 19.91 5.28 0.34 -1.17 -2.12 80.81 31.05 261.04
+226 18.47 8.55 0.29 -2.74 1.19 95.50 36.82 215.52
+227 16.88 7.49 0.22 -1.34 3.23 100.00 44.80 207.37
+228 19.12 9.70 0.04 1.72 3.62 93.28 35.51 234.60
+229 19.72 8.66 0.12 3.73 0.34 99.97 28.87 244.62
+230 19.86 6.71 0.09 2.31 -2.47 62.81 28.58 229.04
+231 19.47 5.53 0.23 1.79 -0.06 78.30 28.84 255.19
+232 18.89 4.15 0.13 1.94 -2.66 63.99 26.75 269.99
+233 17.93 3.75 0.09 -2.04 -0.20 99.99 27.70 244.95
+234 17.35 5.00 0.73 -2.26 2.44 86.27 35.50 220.04
+235 17.68 6.26 0.55 0.21 3.21 83.75 35.15 232.77
+236 17.91 6.49 0.20 1.48 1.88 55.17 34.74 232.88
+237 17.94 6.76 0.50 -0.11 2.21 75.79 34.03 236.46
+238 19.43 7.50 0.04 1.75 1.87 81.15 28.36 246.53
+239 19.31 4.13 0.00 1.81 -1.31 58.74 26.01 255.34
+240 19.47 6.60 0.00 2.58 0.39 52.72 25.65 244.82
+241 20.08 3.27 0.00 0.84 -2.50 52.86 23.09 246.38
+242 18.41 3.49 0.00 -1.95 0.55 69.98 30.94 222.98
+243 20.34 7.03 0.00 2.39 3.36 58.81 24.31 231.88
+244 19.49 5.98 0.00 2.90 2.53 64.09 27.28 234.13
+245 18.02 4.98 0.10 2.74 2.72 68.39 31.88 208.81
+246 14.69 7.00 0.48 2.35 2.97 87.22 40.84 192.12
+247 16.73 6.14 0.33 2.13 3.08 99.98 35.38 217.60
+248 17.05 5.24 0.15 2.03 3.20 68.17 34.60 222.22
+249 16.96 5.11 1.08 2.54 1.23 64.38 33.33 218.46
+250 16.39 6.04 1.23 1.67 1.14 68.32 36.93 207.52
+251 16.56 4.97 0.25 2.08 0.20 80.10 33.58 218.22
+252 18.46 3.67 0.00 3.92 -2.05 82.67 24.94 238.94
+253 18.05 2.80 0.00 4.71 -1.48 56.31 24.39 247.08
+254 17.43 3.58 0.00 4.67 -2.08 53.93 25.51 232.79
+255 16.39 1.36 0.00 1.40 -2.20 62.29 24.33 239.77
+256 16.92 2.60 0.00 -0.03 4.04 54.76 24.30 210.76
+257 16.02 4.74 0.00 1.87 3.06 47.11 24.73 194.80
+258 14.37 3.23 0.00 1.78 2.42 54.51 27.38 203.15
+259 13.95 2.21 0.37 1.93 2.65 59.53 27.90 209.29
+260 16.16 2.21 0.33 3.32 2.39 66.13 29.25 213.42
+261 14.99 5.17 0.61 3.86 0.39 64.59 31.20 186.78
+262 12.38 2.71 0.33 3.48 -2.52 91.85 37.34 207.89
+263 14.02 -0.64 0.00 2.50 -1.25 81.93 29.76 229.11
+264 14.24 0.48 0.00 2.27 -0.07 64.08 30.24 205.30
+265 15.53 2.87 0.00 3.67 2.59 59.65 28.46 203.74
+266 15.36 3.50 0.15 2.90 -0.16 73.52 29.64 201.96
+267 13.40 -1.12 0.52 -2.38 2.25 90.63 41.10 160.39
+268 11.53 -0.50 0.89 -0.17 4.18 100.00 43.11 175.43
+269 14.17 3.78 0.00 3.01 2.92 99.99 36.46 200.85
+270 13.33 2.15 0.19 3.21 -0.17 76.23 34.48 214.45
+271 15.19 1.77 0.00 2.06 1.02 80.02 28.99 194.61
+272 15.98 2.12 0.00 3.18 0.37 82.65 26.13 204.25
+273 15.70 3.77 0.00 2.58 1.67 85.20 28.49 165.68
+274 15.21 3.08 0.00 3.79 0.09 84.85 30.13 198.52
+275 15.52 1.82 0.08 4.29 0.29 68.43 26.04 180.33
+276 15.10 -0.10 0.00 3.97 0.00 60.45 21.45 207.83
+277 15.24 0.73 0.00 5.13 -0.58 42.72 19.79 211.79
+278 14.79 -0.64 0.00 2.01 0.53 45.33 19.32 181.43
+279 15.80 4.01 0.00 3.60 2.25 38.46 19.82 174.00
+280 15.22 2.70 0.00 2.57 0.77 61.80 20.51 151.39
+281 11.33 0.24 0.05 1.73 2.86 87.44 31.11 201.55
+282 10.86 -3.04 0.35 1.78 -2.90 73.73 36.04 170.60
+283 6.11 -6.26 0.06 1.61 -1.97 78.18 26.84 202.93
+284 10.37 -6.39 0.00 2.24 1.45 61.26 24.98 205.30
+285 13.01 -2.20 0.00 3.77 0.12 48.14 20.87 182.27
+286 13.83 -0.23 0.00 5.40 -0.25 39.66 18.73 178.74
+287 12.73 -2.99 0.00 4.32 -0.51 54.87 20.81 191.94
+288 12.91 -2.98 0.00 3.69 -0.21 48.56 20.26 184.29
+289 11.90 -1.05 0.00 0.80 0.31 43.13 21.10 145.93
+290 11.44 -1.35 0.00 -1.48 1.23 46.86 23.31 178.52
+291 11.70 -1.68 0.22 0.46 2.25 74.91 26.39 175.79
+292 13.27 -1.04 0.00 2.40 1.92 99.98 30.98 180.63
+293 14.44 0.73 0.00 3.53 0.58 100.00 28.97 174.79
+294 13.68 1.18 0.00 3.51 0.66 97.77 32.71 188.27
+295 12.34 0.53 0.47 2.21 -0.24 71.28 32.43 135.98
+296 9.52 -0.21 0.00 0.12 2.39 89.08 37.83 143.78
+297 10.68 -1.06 0.00 3.03 1.60 92.30 33.79 175.29
+298 10.46 -0.73 0.15 1.86 0.51 71.00 30.34 159.45
+299 9.40 -0.00 0.16 1.40 2.65 69.02 40.55 139.50
+300 10.45 0.32 0.12 2.87 2.46 74.77 48.20 149.57
+301 10.57 1.74 0.19 3.09 1.90 90.97 47.75 118.51
+302 6.74 -2.71 1.40 2.21 -1.06 84.26 57.13 110.94
+303 4.21 -4.23 0.30 4.07 -3.10 74.41 43.15 123.37
+304 3.79 -6.39 0.08 4.07 -0.25 76.93 41.19 129.44
+305 1.95 -11.95 0.00 7.22 -3.96 57.72 18.33 163.44
+306 -1.59 -13.65 0.00 3.78 -1.80 39.19 12.60 169.01
+307 0.84 -7.32 0.00 4.01 0.22 57.37 13.35 129.79
+308 -0.07 -12.01 0.07 3.03 -4.45 50.13 19.09 166.57
+309 1.75 -9.86 0.00 4.05 -0.28 45.54 22.00 121.89
+310 1.38 -11.99 0.22 3.48 -5.11 60.12 26.29 140.13
+311 -5.61 -12.84 0.38 3.43 -5.70 43.74 27.48 121.37
+312 -9.23 -15.54 0.16 3.38 -4.82 60.35 33.48 122.35
+313 -7.41 -15.77 0.18 1.24 -4.02 74.99 33.35 140.09
+314 -4.11 -16.93 0.00 2.18 -1.51 68.35 29.41 156.42
+315 -1.82 -14.14 0.00 3.32 -1.63 62.35 33.67 146.70
+316 1.18 -13.01 0.00 3.16 -1.35 63.74 32.34 142.58
+317 -0.76 -9.96 0.00 1.24 1.91 57.15 34.64 104.33
+318 4.64 -6.59 0.00 3.05 2.61 92.44 42.69 113.97
+319 3.34 -6.30 0.00 4.18 0.78 99.52 50.30 121.88
+320 5.73 -3.12 0.00 3.35 1.67 99.98 55.98 114.10
+321 7.67 -2.05 0.11 3.13 2.86 83.48 53.98 103.68
+322 6.82 -2.00 0.00 3.64 1.43 78.98 56.55 96.01
+323 3.81 -6.05 0.00 4.45 0.22 90.18 50.77 126.78
+324 2.54 -5.70 0.00 3.83 1.93 96.12 59.45 106.75
+325 5.60 -3.70 0.14 2.37 5.64 85.35 84.87 90.76
+326 5.80 -6.89 0.28 4.99 1.74 99.93 34.69 121.39
+327 -1.72 -13.58 0.00 4.00 0.14 99.93 33.38 133.24
+328 5.23 -9.19 0.00 5.15 0.33 64.35 33.48 121.20
+329 5.81 -5.51 0.00 4.54 1.06 69.13 24.81 123.39
+330 2.69 -6.41 0.00 4.28 1.19 99.94 37.53 110.84
+331 1.64 -10.98 0.00 2.92 0.73 89.48 28.75 123.58
+332 1.25 -9.21 0.06 3.37 0.54 67.09 32.62 114.55
+333 1.32 -8.59 0.00 4.06 -0.41 87.07 28.42 104.34
+334 3.56 -7.44 0.00 6.81 -0.64 59.30 26.61 104.60
+335 6.45 -4.58 0.00 7.14 -0.55 70.67 30.84 100.34
+336 5.64 -3.70 0.00 8.39 -1.10 68.87 35.25 113.98
+337 4.90 -4.86 0.05 4.22 1.68 77.40 44.41 90.80
+338 8.48 -3.61 0.22 5.59 2.51 81.83 46.83 93.89
+339 7.92 -4.83 0.58 5.26 2.42 67.14 45.08 100.28
+340 -2.54 -15.34 0.00 4.25 -0.07 63.86 23.75 119.00
+341 -7.07 -12.77 0.00 4.99 1.29 45.49 19.78 101.18
+342 -3.74 -13.03 0.18 7.88 1.49 48.21 24.68 103.06
+343 -3.68 -13.48 0.00 6.09 -1.76 51.62 32.40 89.50
+344 1.34 -9.80 0.32 4.53 0.68 81.00 31.70 100.11
+345 0.34 -10.40 0.00 5.40 -2.20 58.93 29.26 99.64
+346 2.26 -11.13 0.06 5.02 -0.85 65.80 39.97 89.44
+347 2.51 -6.72 0.00 4.48 -1.28 79.79 42.49 101.05
+348 4.71 -6.40 0.00 4.35 -0.74 77.04 36.09 101.64
+349 4.52 -4.40 0.00 4.23 0.30 98.02 45.73 102.40
+350 -0.83 -9.18 0.19 3.14 0.40 92.36 49.42 84.88
+351 -4.14 -12.76 0.57 2.79 -1.00 99.96 28.77 99.87
+352 -5.36 -13.72 0.39 2.26 3.27 68.64 32.82 82.04
+353 -6.03 -19.58 0.11 2.07 -2.03 81.39 43.80 97.57
+354 -11.32 -23.77 0.13 2.43 -0.76 78.76 35.02 103.97
+355 -1.80 -17.88 0.00 4.28 1.33 81.96 48.02 89.21
+356 -3.38 -12.73 0.00 4.69 -1.58 78.41 43.07 98.89
+357 -2.25 -12.88 0.41 5.13 -0.16 99.95 52.57 88.40
+358 3.73 -4.98 0.35 8.56 0.26 99.98 37.84 102.32
+359 1.47 -5.76 0.06 6.64 -0.28 99.99 44.58 97.92
+360 4.23 -4.64 0.00 6.60 -1.25 68.40 45.88 104.11
+361 4.33 -4.08 0.05 6.04 -0.92 92.00 50.68 102.54
+362 3.23 -6.83 0.18 4.67 -0.34 90.38 38.17 100.36
+363 -4.03 -13.57 0.34 5.26 -1.34 63.48 28.97 102.21
+364 -10.55 -20.44 0.21 3.67 -1.81 54.00 27.03 100.21
+365 -12.35 -22.83 0.00 2.39 -1.04 55.75 28.49 106.85
diff --git a/inst/extdata/example1/Input/estab.in b/inst/extdata/example1/Input/estab.in
index 644438fe..87a85f2f 100644
--- a/inst/extdata/example1/Input/estab.in
+++ b/inst/extdata/example1/Input/estab.in
@@ -1,17 +1,17 @@
-#------ Input file for (optional) plant establishment
-
-
-#--- Activate/deactivate plant establishment calculations
-
-0 # 1/0 = do/don't calculate and output establishment conditions
-
-
-#--- File names with establishment parameters (only used if activated)
-# Each file pertains to a species and contains the
-# soil moisture and timing parameters required for the
-# species to establish in a given year.
-# There is no limit to the number of files in the list.
-# File names with paths relative to the SOILWAT2 working directory (-d flag)
-
-Input/estab/bouteloua.estab
-Input/estab/bromus.estab
+#------ Input file for (optional) plant establishment
+
+
+#--- Activate/deactivate plant establishment calculations
+
+0 # 1/0 = do/don't calculate and output establishment conditions
+
+
+#--- File names with establishment parameters (only used if activated)
+# Each file pertains to a species and contains the
+# soil moisture and timing parameters required for the
+# species to establish in a given year.
+# There is no limit to the number of files in the list.
+# File names with paths relative to the SOILWAT2 working directory (-d flag)
+
+Input/estab/bouteloua.estab
+Input/estab/bromus.estab
diff --git a/inst/extdata/example1/Input/outsetup.in b/inst/extdata/example1/Input/outsetup.in
index 193c6865..beb94c5c 100755
--- a/inst/extdata/example1/Input/outsetup.in
+++ b/inst/extdata/example1/Input/outsetup.in
@@ -1,75 +1,75 @@
-# Output setup file for SOILWAT2
-#
-# Notes:
-# Time periods available: DY,WK,MO,YR
-# eg, if DY is chosen then 100,200 would mean to use the second hundred days
-# But if YR is chosen, start and end numbers are in days so only those days
-# are reported for the yearly average.
-# Some keys from older versions (fortran and the c versions mimicking the fortran
-# version) are not currently implemented:
-# ALLH20, WTHR.
-#
-# ESTABL only produces yearly output, namely, DOY for each species requested.
-# Thus, to minimize typo errors, all flags are ignored except the filename.
-# Output is simply the day of the year establishment occurred for each species
-# in each year of the model run. Refer to the estabs.in file for more info.
-#
-# DEEPSWC produces output only if the deepdrain flag is set in siteparam.in.
-#
-# Filename prefixes should not have a file extension.
-# Case is unimportant.
-#
-# SUMTYPEs are one of the following:
-# OFF - no output for this variable
-# SUM - sum the variable for each day in the output period
-# AVG - average the variable over the output period
-# FIN - output value of final day in the period; soil water variables only.
-# Note that SUM and AVG are the same if timeperiod = dy.
-#
-# (3-Sep-03) OUTSEP key indicates the output separator. This method
-# allows older files to work with the new version. The default is a
-# tab. Other options are 's', 't', or 'c' for space, tab, or comma (no quotes)
-# or any other printable character as itself (eg, :;| etc). The given
-# separator will apply to all of the output files. Note that only lowercase
-# letters 's' or 't' are synonyms.
-#
-# (01/17/2013) TIMESTEP key indicates which periods you want to output.
-# You can output all the periods at a time, just one, or however many
-# you want. To change which periods to output type 'dy' for day,
-# 'wk' for week, 'mo' for month, and 'yr' for year after TIMESTEP
-# in any order. For example: 'TIMESTEP mo wk' will output for month and week
-#
-
-OUTSEP c
-TIMESTEP dy wk mo yr # must be lowercase
-
-# KEY SUMTYPE PERIOD START END FILENAME_PREFIX DESCRIPTION
- TEMP AVG WK 1 end temp_air /* max., min., average air temperature (C) max., min., average surface temperature (C)*/
- PRECIP SUM MO 1 end precip /* precipitation, rainfall, snowfall, snowmelt, and snowloss (sublimation) (cm) */
- SOILINFILT SUM YR 1 end infiltration /* water to infiltrate in top soil layer (cm) */
- RUNOFF SUM WK 1 end runoff /* runoff/runon (cm): net runoff, runoff from ponded water, runoff from snowmelt, runon of surface water from hypothetical upslope neighbor */
- VWCBULK AVG MO 1 end vwc_bulk /* bulk volumetric soilwater (cm / layer) */
- VWCMATRIC AVG YR 1 end vwc_matric /* matric volumetric soilwater (cm / layer) */
- SWCBULK AVG DY 1 end swc_bulk /* bulk soilwater content (cm / cm layer); swc.l1(today) = swc.l1(yesterday)+inf_soil-lyrdrain.l1-transp.l1-evap_soil.l1; swc.li(today) = swc.li(yesterday)+lyrdrain.l(i-1)-lyrdrain.li-transp.li-evap_soil.li; swc.llast(today) = swc.llast(yesterday)+lyrdrain.l(last-1)-deepswc-transp.llast-evap_soil.llast */
- SWA AVG YR 1 end swa /* plant available soil water (cm / layer): trees, shrubs, forbs, grasses */
- SWABULK AVG MO 1 end swa_bulk /* DEFUNCT: MAY BE REMOVED IN FUTURE VERSIONS; bulk available soil water (cm/layer) = swc - wilting point */
- SWAMATRIC AVG YR 1 end swa_matric /* DEFUNCT: MAY BE REMOVED IN FUTURE VERSIONS; matric available soil water (cm/layer) = swc - wilting point */
- SWPMATRIC AVG WK 1 end swp_matric /* matric soilwater potential (-bars) */
- SURFACEWATER AVG DY 1 end surface_water /* surface water (cm) */
- TRANSP SUM YR 1 end transp /* transpiration from each soil layer (cm): total, trees, shrubs, forbs, grasses */
- EVAPSOIL SUM DY 1 end evap_soil /* bare-soil evaporation from each soil layer (cm) */
- EVAPSURFACE SUM WK 1 end evap_surface /* evaporation (cm): total, trees, shrubs, forbs, grasses, litter, surface water */
- INTERCEPTION SUM MO 1 end interception /* intercepted rain (cm): total, trees, shrubs, forbs, grasses, and litter (cm) */
- LYRDRAIN SUM DY 1 end percolation /* water percolated from each layer (cm) */
- HYDRED SUM WK 1 end hydred /* hydraulic redistribution from each layer (cm): total, trees, shrubs, forbs, grasses */
- AET SUM YR 1 end aet /* actual evapotranspiration (cm), transpiration (cm), bare-soil evaporation (cm), evaporation from canopy water (cm), evaporation from ponded water (cm), evaporation from snow (sublimation) (cm) */
- PET SUM DY 1 end pet /* potential evapotranspiration (cm), extraterrestrial horizontal solar irradiation [MJ/m2], extraterrestrial tilted solar irradiation [MJ/m2], global horizontal irradiation [MJ/m2], global tilted irradiation [MJ/m2] */
- WETDAY SUM DY 1 end wetdays /* days above swc_wet */
- SNOWPACK AVG WK 1 end snowpack /* snowpack water equivalent (cm), snowdepth (cm); since snowpack is already summed, use avg - sum sums the sums = nonsense */
- DEEPSWC SUM MO 1 end deep_drain /* deep drainage into lowest layer (cm) */
+# Output setup file for SOILWAT2
+#
+# Notes:
+# Time periods available: DY,WK,MO,YR
+# eg, if DY is chosen then 100,200 would mean to use the second hundred days
+# But if YR is chosen, start and end numbers are in days so only those days
+# are reported for the yearly average.
+# Some keys from older versions (fortran and the c versions mimicking the fortran
+# version) are not currently implemented:
+# ALLH20, WTHR.
+#
+# ESTABL only produces yearly output, namely, DOY for each species requested.
+# Thus, to minimize typo errors, all flags are ignored except the filename.
+# Output is simply the day of the year establishment occurred for each species
+# in each year of the model run. Refer to the estabs.in file for more info.
+#
+# DEEPSWC produces output only if the deepdrain flag is set in siteparam.in.
+#
+# Filename prefixes should not have a file extension.
+# Case is unimportant.
+#
+# SUMTYPEs are one of the following:
+# OFF - no output for this variable
+# SUM - sum the variable for each day in the output period
+# AVG - average the variable over the output period
+# FIN - output value of final day in the period; soil water variables only.
+# Note that SUM and AVG are the same if timeperiod = dy.
+#
+# (3-Sep-03) OUTSEP key indicates the output separator. This method
+# allows older files to work with the new version. The default is a
+# tab. Other options are 's', 't', or 'c' for space, tab, or comma (no quotes)
+# or any other printable character as itself (eg, :;| etc). The given
+# separator will apply to all of the output files. Note that only lowercase
+# letters 's' or 't' are synonyms.
+#
+# (01/17/2013) TIMESTEP key indicates which periods you want to output.
+# You can output all the periods at a time, just one, or however many
+# you want. To change which periods to output type 'dy' for day,
+# 'wk' for week, 'mo' for month, and 'yr' for year after TIMESTEP
+# in any order. For example: 'TIMESTEP mo wk' will output for month and week
+#
+
+OUTSEP c
+TIMESTEP dy wk mo yr # must be lowercase
+
+# KEY SUMTYPE PERIOD START END FILENAME_PREFIX DESCRIPTION
+ TEMP AVG WK 1 end temp_air /* max., min., average air temperature (C) max., min., average surface temperature (C)*/
+ PRECIP SUM MO 1 end precip /* precipitation, rainfall, snowfall, snowmelt, and snowloss (sublimation) (cm) */
+ SOILINFILT SUM YR 1 end infiltration /* water to infiltrate in top soil layer (cm) */
+ RUNOFF SUM WK 1 end runoff /* runoff/runon (cm): net runoff, runoff from ponded water, runoff from snowmelt, runon of surface water from hypothetical upslope neighbor */
+ VWCBULK AVG MO 1 end vwc_bulk /* bulk volumetric soilwater (cm / layer) */
+ VWCMATRIC AVG YR 1 end vwc_matric /* matric volumetric soilwater (cm / layer) */
+ SWCBULK AVG DY 1 end swc_bulk /* bulk soilwater content (cm / cm layer); swc.l1(today) = swc.l1(yesterday)+inf_soil-lyrdrain.l1-transp.l1-evap_soil.l1; swc.li(today) = swc.li(yesterday)+lyrdrain.l(i-1)-lyrdrain.li-transp.li-evap_soil.li; swc.llast(today) = swc.llast(yesterday)+lyrdrain.l(last-1)-deepswc-transp.llast-evap_soil.llast */
+ SWA AVG YR 1 end swa /* plant available soil water (cm / layer): trees, shrubs, forbs, grasses */
+ SWABULK AVG MO 1 end swa_bulk /* DEFUNCT: MAY BE REMOVED IN FUTURE VERSIONS; bulk available soil water (cm/layer) = swc - wilting point */
+ SWAMATRIC AVG YR 1 end swa_matric /* DEFUNCT: MAY BE REMOVED IN FUTURE VERSIONS; matric available soil water (cm/layer) = swc - wilting point */
+ SWPMATRIC AVG WK 1 end swp_matric /* matric soilwater potential (-bars) */
+ SURFACEWATER AVG DY 1 end surface_water /* surface water (cm) */
+ TRANSP SUM YR 1 end transp /* transpiration from each soil layer (cm): total, trees, shrubs, forbs, grasses */
+ EVAPSOIL SUM DY 1 end evap_soil /* bare-soil evaporation from each soil layer (cm) */
+ EVAPSURFACE SUM WK 1 end evap_surface /* evaporation (cm): total, trees, shrubs, forbs, grasses, litter, surface water */
+ INTERCEPTION SUM MO 1 end interception /* intercepted rain (cm): total, trees, shrubs, forbs, grasses, and litter (cm) */
+ LYRDRAIN SUM DY 1 end percolation /* water percolated from each layer (cm) */
+ HYDRED SUM WK 1 end hydred /* hydraulic redistribution from each layer (cm): total, trees, shrubs, forbs, grasses */
+ AET SUM YR 1 end aet /* actual evapotranspiration (cm), transpiration (cm), bare-soil evaporation (cm), evaporation from canopy water (cm), evaporation from ponded water (cm), evaporation from snow (sublimation) (cm) */
+ PET SUM DY 1 end pet /* potential evapotranspiration (cm), extraterrestrial horizontal solar irradiation [MJ/m2], extraterrestrial tilted solar irradiation [MJ/m2], global horizontal irradiation [MJ/m2], global tilted irradiation [MJ/m2] */
+ WETDAY SUM DY 1 end wetdays /* days above swc_wet */
+ SNOWPACK AVG WK 1 end snowpack /* snowpack water equivalent (cm), snowdepth (cm); since snowpack is already summed, use avg - sum sums the sums = nonsense */
+ DEEPSWC SUM MO 1 end deep_drain /* deep drainage into lowest layer (cm) */
SOILTEMP AVG MO 1 end temp_soil /* soil temperature from each soil layer (in celsius) */
- FROZEN AVG MO 1 end frozen_soil /*Frozen state for each soil layer */
- ESTABL OFF YR 1 end estabs /* yearly establishment results */
- CO2EFFECTS AVG DY 1 end co2effects /* vegetation CO2-effect (multiplier) for trees, shrubs, forbs, grasses; WUE CO2-effect (multiplier) for trees, shrubs, forbs, grasses */
- BIOMASS AVG DY 1 end vegetation /* vegetation: cover (%) for trees, shrubs, forbs, grasses; biomass (g/m2 as component of total) for total, trees, shrubs, forbs, grasses, and litter; live biomass (g/m2 as component of total) total, trees, shrubs, forbs, grasses; leaf area index LAI (m2/m2) */
-
+ FROZEN AVG MO 1 end frozen_soil /*Frozen state for each soil layer */
+ ESTABL OFF YR 1 end estabs /* yearly establishment results */
+ CO2EFFECTS AVG DY 1 end co2effects /* vegetation CO2-effect (multiplier) for trees, shrubs, forbs, grasses; WUE CO2-effect (multiplier) for trees, shrubs, forbs, grasses */
+ BIOMASS AVG DY 1 end vegetation /* vegetation: cover (%) for trees, shrubs, forbs, grasses; biomass (g/m2 as component of total) for total, trees, shrubs, forbs, grasses, and litter; live biomass (g/m2 as component of total) total, trees, shrubs, forbs, grasses; leaf area index LAI (m2/m2) */
+
diff --git a/inst/extdata/example1/Input/siteparam.in b/inst/extdata/example1/Input/siteparam.in
index 28b936e9..bce9a055 100644
--- a/inst/extdata/example1/Input/siteparam.in
+++ b/inst/extdata/example1/Input/siteparam.in
@@ -9,9 +9,11 @@
#---- Soil water content initialization, minimum, and wet condition
--1.0 # swc_min : cm/cm if 0 - <1.0, -bars if >= 1.0.; if < 0. then estimate residual water content for each layer
-15.0 # swc_init: cm/cm if < 1.0, -bars if >= 1.0.
-15.0 # swc_wet : cm/cm if < 1.0, -bars if >= 1.0.
+-1.0 # swc_min : [cm/cm] if >= 0. and < 1.0
+ # [-bars] if >= 1.0.
+ # estimate (from realistic limit and Rawls et al. 1985) if < 0.
+15.0 # swc_init: [cm/cm] if < 1.0, [-bars] if >= 1.0.
+15.0 # swc_wet : [cm/cm] if < 1.0, [-bars] if >= 1.0.
#---- Diffuse recharge and runoff/runon
0 # reset (1/0): do/don't reset soil water content for each year
@@ -83,6 +85,34 @@ NAN # aspect = surface azimuth angle (degrees): S=0, E=-90, N=±180, W=90;
# Name of CO2 scenario: see input file `carbon.in`
RCP85
+
+# --- Soil characterization ---
+# Are inputs of density representing bulk soil (type 1) or the matric component (type 0)?
+0
+
+
+#--- Soil water retention curve (SWRC) ------
+#
+# Implemented options (`swrc_name`/`ptf_name`, see `swrc2str[]`/`ptf2str[]`):
+# - ptf_name = : SWRC parameters must be provided via "swrc_params.in"
+# - swrc_name = "Campbell1974" (Campbell 1974)
+# * ptf_name = "Cosby1984AndOthers" (Cosby et al. 1984 but `swc_sat` by Saxton et al. 2006)
+# * ptf_name = "Cosby1984" (Cosby et al. 1984)
+# - swrc_name = "vanGenuchten1980" (van Genuchten 1980)
+# - swrc_name = "FXW" (Fredlund and Xing 1994, Wang et al. 2018)
+#
+# Note: option "Campbell1974"/"Cosby1984AndOthers" was hard-coded < v7.0.0
+# Note: `rSOILWAT2` may implement additional PTFs
+
+Campbell1974 # Specify soil water retention curve
+Cosby1984AndOthers # Specify pedotransfer function
+ # (if not implemented, then provide SWRC parameters via "swrc_params.in")
+
+0 # Has SWRC parameters (see `has_swrcp`)?
+ # 0: Estimate with specified pedotransfer function
+ # 1: Use values from "swrc_params.in"
+
+
#---- Transpiration regions
# ndx : 1=shallow, 2=medium, 3=deep, 4=very deep
# layer: deepest soil layer number of the region.
diff --git a/inst/extdata/example1/Input/swrc_params.in b/inst/extdata/example1/Input/swrc_params.in
new file mode 100644
index 00000000..f05fb9e0
--- /dev/null
+++ b/inst/extdata/example1/Input/swrc_params.in
@@ -0,0 +1,39 @@
+#------ Input for Soil Water Retention Curves (by soil layer) ------
+
+# A table with up to `MAX_LAYERS` rows (soil layers) and 6 columns:
+# - the soil layers must match `soils.in`
+# - the interpretation of columns (SWRC parameters) depends on the
+# selected SWRC (see `siteparam.in`)
+# - unused columns are ignored (if selected SWRC uses fewer than 6 parameters)
+
+# swrc = "Campbell1974" (default values below, from "Cosby1984")
+# * param1 = air-entry suction [cm]
+# * param2 = saturated volumetric water content for the matric component [cm/cm]
+# * param3 = b, slope of the linear log-log retention curve [-]
+# * param4 = saturated hydraulic conductivity [cm/day]
+
+# swrc = "vanGenuchten1980"
+# * param1 = residual volumetric water content for the matric component [cm/cm]
+# * param2 = saturated volumetric water content for the matric component [cm/cm]
+# * param3 = alpha, related to the inverse of air entry suction [cm-1]
+# * param4 = n, measure of the pore-size distribution [-]
+# * param5 = saturated hydraulic conductivity [cm/day]
+
+# swrc = "FXW"
+# * param1 = saturated volumetric water content of the matric component [cm/cm]
+# * param2 = alpha, shape parameter [cm-1]
+# * param3 = n, shape parameter [-]
+# * param4 = m, shape parameter [-]
+# * param5 = saturated hydraulic conductivity [cm / day]
+# * param6 = L, tortuosity/connectivity parameter [-]
+
+
+# param1 param2 param3 param4 param5 param6
+18.6080 0.42703 5.3020 24.03047 0.0000 0.0000
+20.4644 0.43290 7.0500 14.94351 0.0000 0.0000
+22.8402 0.44013 9.4320 13.71177 0.0000 0.0000
+24.0381 0.44291 10.0690 13.43171 0.0000 0.0000
+24.2159 0.44359 10.3860 14.14351 0.0000 0.0000
+23.3507 0.44217 10.3830 40.63764 0.0000 0.0000
+12.3880 0.41370 7.3250 37.22899 0.0000 0.0000
+12.3880 0.41370 7.3250 37.22899 0.0000 0.0000
diff --git a/inst/extdata/example1/Input/swrc_params_FXW.in b/inst/extdata/example1/Input/swrc_params_FXW.in
new file mode 100644
index 00000000..7f1bc8df
--- /dev/null
+++ b/inst/extdata/example1/Input/swrc_params_FXW.in
@@ -0,0 +1,26 @@
+#------ Input for Soil Water Retention Curves (by soil layer) ------
+
+# A table with up to `MAX_LAYERS` rows (soil layers) and 6 columns:
+# - the soil layers must match `soils.in`
+# - the interpretation of columns (SWRC parameters) depends on the
+# selected SWRC (see `siteparam.in`)
+# - unused columns are ignored (if selected SWRC uses fewer than 6 parameters)
+
+# swrc = "FXW" (values below, from "neuroFX2021")
+# * param1 = saturated volumetric water content of the matric component [cm/cm]
+# * param2 = alpha, shape parameter [cm-1]
+# * param3 = n, shape parameter [-]
+# * param4 = m, shape parameter [-]
+# * param5 = saturated hydraulic conductivity [cm / day]
+# * param6 = L, tortuosity/connectivity parameter [-]
+
+
+# param1 param2 param3 param4 param5 param6
+0.437461 0.050757 1.247689 0.308681 22.985379 2.697338
+0.452401 0.103033 1.146533 0.195394 89.365566 2.843288
+0.471163 0.149055 1.143810 0.124494 332.262496 2.988864
+0.475940 0.153117 1.141559 0.112295 420.418728 3.012669
+0.480690 0.157887 1.142653 0.105748 534.172981 3.049937
+0.538088 0.174184 1.124589 0.098441 978.516197 3.287010
+0.453070 0.169900 1.308269 0.182713 672.009929 3.218662
+0.453070 0.169900 1.308269 0.182713 672.009929 3.218662
diff --git a/inst/extdata/example1/Input/swrc_params_vanGenuchten1980.in b/inst/extdata/example1/Input/swrc_params_vanGenuchten1980.in
new file mode 100644
index 00000000..d31396bc
--- /dev/null
+++ b/inst/extdata/example1/Input/swrc_params_vanGenuchten1980.in
@@ -0,0 +1,24 @@
+#------ Input for Soil Water Retention Curves (by soil layer) ------
+
+# A table with up to `MAX_LAYERS` rows (soil layers) and 6 columns:
+# - the soil layers must match `soils.in`
+# - the interpretation of columns (SWRC parameters) depends on the
+# selected SWRC (see `siteparam.in`)
+# - unused columns are ignored (if selected SWRC uses fewer than 6 parameters)
+
+# swrc = "vanGenuchten1980" (values below, from "Rosetta3")
+# * param1 = residual volumetric water content for the matric component [cm/cm]
+# * param2 = saturated volumetric water content for the matric component [cm/cm]
+# * param3 = alpha, related to the inverse of air entry suction [cm-1]
+# * param4 = n, measure of the pore-size distribution [-]
+# * param5 = saturated hydraulic conductivity [cm/day]
+
+# param1 param2 param3 param4 param5 param6
+0.07564425 0.3925437 0.010035788 1.412233 19.871040 0
+0.10061329 0.4011315 0.009425738 1.352274 9.090754 0
+0.12060752 0.4278807 0.010424896 1.287923 7.862807 0
+0.12336711 0.4393192 0.010807529 1.274654 9.100139 0
+0.12461498 0.4444546 0.011155912 1.267327 9.902011 0
+0.12480807 0.4426857 0.011408809 1.264873 9.784818 0
+0.10129327 0.3878319 0.014241212 1.311722 10.985124 0
+0.10129327 0.3878319 0.014241212 1.311722 10.985124 0
diff --git a/inst/extdata/example1/Input/veg.in b/inst/extdata/example1/Input/veg.in
index 51e67b31..0bde58b4 100755
--- a/inst/extdata/example1/Input/veg.in
+++ b/inst/extdata/example1/Input/veg.in
@@ -8,6 +8,10 @@
# describe the four available vegetation types and should not be
# modified unless a vegetation type itself is altered.
+#---- Select method for vegetation parameters
+0 # 0 - Use values from this file
+ # 1 - Estimate vegetation composition from long-term climate conditions
+ # (values for other vegetation parameters from this file)
#---- Composition of vegetation type components (0-1; must add up to 1)
# Grasses Shrubs Trees Forbs BareGround
diff --git a/inst/extdata/example1/Input/weathsetup.in b/inst/extdata/example1/Input/weathsetup.in
index f663d216..74e611c9 100755
--- a/inst/extdata/example1/Input/weathsetup.in
+++ b/inst/extdata/example1/Input/weathsetup.in
@@ -10,13 +10,47 @@
0 # 0 = use historical data only
# 1 = use weather generator for (partially) missing weather inputs
# 2 = use weather generator for all weather (don't check weather inputs)
+ # 3 = impute missing temperature with LOCF and missing precipitation as 0
7 # Seed random number generator for weather generator (only used if SOILWAT2)
# (seed with 0 to use current time)
-#--- Historical daily weather inputs
--1 # first year to begin historical weather
- # if -1, then use first year of simulation (see `years.in`)
+#--- Flags describing mean monthly climate input usage:
+# 0 = Don't use mean monthly input
+# 1 = Use mean monthly input (climate.in) and override respective flag for daily input, if flags conflict
+1 # Sky cover
+1 # Wind speed
+1 # Relative humidity
+
+
+#--- Flags describing daily weather input files "weath.YYYY":
+# 0 = Variable is absent
+# 1 = Daily variable present
+# Note: The order of input values within input files must match the order of flags below (e.g., cloud cover cannot precede minimum temperature)
+# Note: If maximum/minimum temperature or precipitation is set to 0 or a flag is set to 1, and the input data is not complete, the program will crash
+1 # Maximum daily temperature [C]
+1 # Minimum daily temperature [C]
+1 # Precipitation [cm]
+0 # Cloud cover [%]
+0 # Wind speed [m/s]
+0 # Wind speed eastward component [m/s]
+0 # Wind speed northward component [m/s]
+0 # Relative humidity [%]
+0 # Maximum relative humidity [%]
+0 # Minimum relative humidity [%]
+0 # Specific humidity [%]
+0 # Dew point temperature [C]
+0 # Actual vapor pressure [kPa]
+0 # Downward surface shortwave radiation (see `Daily weather input descriptions`)
+
+
+#--- Daily weather input descriptions
+0 # Description of downward surface shortwave radiation
+ # * 0: `rsds` represents daily global horizontal irradiation [MJ / m2]
+ # * 1: `rsds` represents flux density [W / m2] for a
+ # (hypothetical) flat horizon averaged over an entire day (24 hour period)
+ # * 2: `rsds` represents flux density [W / m2] for a
+ # (hypothetical) flat horizon averaged over the daylight period of the day
#--- Monthly scaling parameters:
@@ -27,16 +61,18 @@
# SkyCover = additive for mean monthly sky cover [%]; min(100, max(0, scale + sky cover))
# Wind = multiplicative for mean monthly wind speed; max(0, scale * wind speed)
# rH = additive for mean monthly relative humidity [%]; min(100, max(0, scale + rel. Humidity))
-#Mon PPT MaxT MinT SkyCover Wind rH
-1 1.000 0.00 0.00 0.0 1.0 0.0
-2 1.000 0.00 0.00 0.0 1.0 0.0
-3 1.000 0.00 0.00 0.0 1.0 0.0
-4 1.000 0.00 0.00 0.0 1.0 0.0
-5 1.000 0.00 0.00 0.0 1.0 0.0
-6 1.000 0.00 0.00 0.0 1.0 0.0
-7 1.000 0.00 0.00 0.0 1.0 0.0
-8 1.000 0.00 0.00 0.0 1.0 0.0
-9 1.000 0.00 0.00 0.0 1.0 0.0
-10 1.000 0.00 0.00 0.0 1.0 0.0
-11 1.000 0.00 0.00 0.0 1.0 0.0
-12 1.000 0.00 0.00 0.0 1.0 0.0
+# ActVP = multiplicative for actual vapor pressure [kPa]; max(0, scale * actual vapor pressure)
+# ShortWR = multiplicative for shortwave radiation [W/m2]; max(0, scale * shortwave radiation)
+#Mon PPT MaxT MinT SkyCover Wind rH ActVP ShortWR
+1 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+2 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+3 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+4 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+5 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+6 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+7 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+8 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+9 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+10 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+11 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
+12 1.000 0.00 0.00 0.0 1.0 0.0 1.0 1.0
diff --git a/inst/extdata/example1/files.in b/inst/extdata/example1/files.in
index 53174483..fe3aa484 100755
--- a/inst/extdata/example1/files.in
+++ b/inst/extdata/example1/files.in
@@ -11,6 +11,7 @@ Output/logfile.log # Output file to which warnings, errors, and other important
#--- Description of simulated site
Input/siteparam.in # Input file for site location, initialization, and miscellaneous model parameters
Input/soils.in # Input for soil information: soil layer, soil texture, etc.
+Input/swrc_params.in # Input for soil water retention curve (used if pdf_type = 0, i.e., pedotransfer functions are not used)
#--- Inputs of weather forcing and description of climate conditions
Input/weathsetup.in # Input file for weather-related parameters and weather generator settings
diff --git a/man/SWRCs.Rd b/man/SWRCs.Rd
new file mode 100644
index 00000000..ebf56e99
--- /dev/null
+++ b/man/SWRCs.Rd
@@ -0,0 +1,87 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{SWRCs}
+\alias{SWRCs}
+\title{Functionality for Soil Water Retention Curves (\code{SWRC})}
+\arguments{
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{fcoarse}{A numeric value or vector.
+Coarse fragments, e.g., gravel, (> 2 mm; units of \verb{[m3/m3]})
+relative to the whole soil of each soil layer.
+\code{fcoarse} is required, for instance, to translate between
+values relative to the matric soil component (< 2 mm fraction) and
+relative to the whole soil (matric soil plus coarse fragments).}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{layer_width}{A numeric value or vector.
+Depth interval, width, of each soil layer (units of \code{cm}).
+\code{layer_width} is required to translate between
+soil water content of a soil layer and volumetric water content.}
+
+\item{swrc_name}{An character string or vector.
+The selected \code{SWRC} name
+(one of \code{\link[=swrc_names]{swrc_names()}}, with default \code{"Campbell1974"}).}
+
+\item{ptf_name}{An character string or vector.
+The selected \code{PTF} name
+(one of \code{\link[=ptf_names]{ptf_names()}}, with default \code{"Cosby1984AndOthers"}).}
+
+\item{swrcp}{A numeric vector or matrix.
+The parameters of a selected \code{SWRC};
+each row represents one \code{SWRC}, e.g., one per soil layer.}
+
+\item{swrc}{A named list.
+Contains all necessary elements of a \code{SWRC},
+i.e., \code{name} (short for \code{swrc_name}) and \code{swrcp},
+or all necessary elements to estimate parameters of a \code{SWRC} given
+soil parameters, i.e., \code{swrc_name} and \code{ptf_name}.}
+
+\item{fail}{A logical value.
+Issue a warning (\code{FALSE}, default) or throw an error (\code{TRUE})
+if request fails.}
+
+\item{verbose}{A logical value. If \code{TRUE}, then display
+\code{SOILWAT2} internal warnings and other messages.}
+
+\item{...}{Additional function arguments passed on or ignored.}
+}
+\description{
+\code{SWRCs} convert between soil water content and soil water potential
+using a set of parameters, see \code{\link[=swrc_swp_to_vwc]{swrc_swp_to_vwc()}} and \code{\link[=swrc_vwc_to_swp]{swrc_vwc_to_swp()}}.
+
+The \code{SWRC} parameters may be estimated from soil properties with suitable
+pedotransfer functions \code{PTFs}, see \code{\link[=ptf_estimate]{ptf_estimate()}}.
+
+The \code{SWRC} parameters can be checked for consistency with \code{\link[=check_swrcp]{check_swrcp()}}.
+}
+\section{Details}{
+
+\code{\link[=swrc_names]{swrc_names()}} lists implemented \code{SWRCs};
+\code{\link[=ptf_names]{ptf_names()}} lists implemented \code{PTFs}.
+}
+
+\references{
+Cosby, B. J., G. M. Hornberger, R. B. Clapp, & T. R. Ginn. 1984.
+A statistical exploration of the relationships of soil moisture
+characteristics to the physical properties of soils.
+Water Resources Research, 20:682-690, \doi{10.1029/WR020i006p00682}
+}
+\seealso{
+\code{\link[=swrc_names]{swrc_names()}},
+\code{\link[=ptf_names]{ptf_names()}},
+\code{\link[=check_ptf_availability]{check_ptf_availability()}},
+\code{\link[=ptf_estimate]{ptf_estimate()}},
+\code{\link[=check_swrcp]{check_swrcp()}},
+\code{\link[=swrc_swp_to_vwc]{swrc_swp_to_vwc()}},
+\code{\link[=swrc_vwc_to_swp]{swrc_vwc_to_swp()}}
+}
diff --git a/man/TranspCoeffByVegType.Rd b/man/TranspCoeffByVegType.Rd
index 96a88120..153a30e4 100644
--- a/man/TranspCoeffByVegType.Rd
+++ b/man/TranspCoeffByVegType.Rd
@@ -13,6 +13,20 @@ TranspCoeffByVegType(
adjustType = c("positive", "inverse", "allToLast")
)
}
+\arguments{
+\item{tr_input_code}{The \code{"desc"} component of \code{\link{sw2_trco_table}}.}
+
+\item{tr_input_coeff}{The \code{"data"} component of \code{\link{sw2_trco_table}}.}
+
+\item{soillayer_no}{An integer value. The number of soil layers.}
+
+\item{trco_type}{A character string. A column name of \code{tr_input_code}.}
+
+\item{layers_depth}{An integer vector. The lower depths of soil layers \code{\link{cm}}}
+
+\item{adjustType}{A character string. The method to adjust prescribed
+coefficient profile onto provided depth profile \code{layers_depth}.}
+}
\description{
Lookup transpiration coefficients for grasses, shrubs, and trees per soil
layer or per soil depth increment of 1 cm per distribution type for
@@ -20,15 +34,13 @@ each simulation run and copy values to \var{\sQuote{datafile.soils}}
}
\details{
\itemize{
- \item first row of datafile is label for per soil layer
- \var{\dQuote{Layer}} or per soil depth increment of 1 cm
- \var{\dQuote{DepthCM}}
- \item second row of datafile is source of data
- \item the other rows contain the data for each distribution type = columns
+\item first row of datafile is label for per soil layer
+\var{\dQuote{Layer}} or per soil depth increment of 1 cm
+\var{\dQuote{DepthCM}}
+\item second row of datafile is source of data
+\item the other rows contain the data for each distribution type = columns
}
}
-\section{Note}{
- cannot write data from \var{\sQuote{sw_input_soils}} to
- \var{\sQuote{datafile.soils}}
+\seealso{
+\code{\link[=estimate_PotNatVeg_roots]{estimate_PotNatVeg_roots()}} with example code
}
-
diff --git a/man/activate_swOUT_OutKey.Rd b/man/activate_swOUT_OutKey-set.Rd
similarity index 84%
rename from man/activate_swOUT_OutKey.Rd
rename to man/activate_swOUT_OutKey-set.Rd
index 94ad0382..51267d2d 100644
--- a/man/activate_swOUT_OutKey.Rd
+++ b/man/activate_swOUT_OutKey-set.Rd
@@ -1,9 +1,11 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/A_swGenericMethods.R
-\name{activate_swOUT_OutKey}
+\name{activate_swOUT_OutKey-set}
+\alias{activate_swOUT_OutKey-set}
\alias{activate_swOUT_OutKey}
-\alias{activate_swOUT_OutKey,}
\alias{deactivate_swOUT_OutKey}
+\alias{deactivate_swOUT_OutKey-set}
+\alias{activate_swOUT_OutKey<-}
\alias{deactivate_swOUT_OutKey<-}
\title{Activate/deactivate an output slot (\var{swOUT_OutKey})}
\usage{
diff --git a/man/adjBiom_by_ppt.Rd b/man/adjBiom_by_ppt.Rd
deleted file mode 100644
index a4285b49..00000000
--- a/man/adjBiom_by_ppt.Rd
+++ /dev/null
@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_Vegetation.R
-\name{adjBiom_by_ppt}
-\alias{adjBiom_by_ppt}
-\title{Adjust mean monthly biomass values by precipitation}
-\usage{
-adjBiom_by_ppt(
- biom_shrubs,
- biom_C3,
- biom_C4,
- biom_annuals,
- biom_maxs,
- map_mm_shrubs,
- map_mm_std_shrubs,
- map_mm_grasses,
- map_mm_std_grasses,
- vegcomp_std_shrubs,
- vegcomp_std_grass
-)
-}
-\description{
-Adjust mean monthly biomass values by precipitation
-}
-\section{Details}{
- Internally used by
- \code{\link{estimate_PotNatVeg_biomass}}.
-}
-
diff --git a/man/adj_phenology_by_temp.Rd b/man/adj_phenology_by_temp.Rd
index 7244b06e..a1e5cce0 100644
--- a/man/adj_phenology_by_temp.Rd
+++ b/man/adj_phenology_by_temp.Rd
@@ -119,6 +119,7 @@ rSW2utils::scale_to_reference_peak_frequency(
)
## Plot reference and adjusted monthly values
+if (interactive()) {
par_prev <- par(mfrow = c(2, 1))
plot(
@@ -148,5 +149,6 @@ plot(
lines(1:12, phen_adj[, 2])
par(par_prev)
+}
}
diff --git a/man/calc_dailyInputFlags.Rd b/man/calc_dailyInputFlags.Rd
new file mode 100644
index 00000000..44077af0
--- /dev/null
+++ b/man/calc_dailyInputFlags.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{calc_dailyInputFlags}
+\alias{calc_dailyInputFlags}
+\title{Determine used weather variables based on values}
+\usage{
+calc_dailyInputFlags(x, name_data = weather_dataColumns())
+}
+\arguments{
+\item{x}{Weather data, i.e.,
+a list where each element is of class \code{\link{swWeatherData}}, or
+a data frame with appropriate columns (see \code{\link[=dbW_weatherData_to_dataframe]{dbW_weatherData_to_dataframe()}}).}
+
+\item{name_data}{A vector of character strings. The column names of \code{x}
+with weather variables.}
+}
+\value{
+A logical vector for each of the possible input variables with
+\code{TRUE} if at least one value is not missing.
+}
+\description{
+Determine used weather variables based on values
+}
+\examples{
+calc_dailyInputFlags(rSOILWAT2::weatherData)
+calc_dailyInputFlags(dbW_weatherData_to_dataframe(rSOILWAT2::weatherData))
+
+
+}
diff --git a/man/check_SWRC_vs_PTF.Rd b/man/check_SWRC_vs_PTF.Rd
new file mode 100644
index 00000000..394ebe59
--- /dev/null
+++ b/man/check_SWRC_vs_PTF.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{check_SWRC_vs_PTF}
+\alias{check_SWRC_vs_PTF}
+\title{Check whether \code{PTF} and \code{SWRC} are compatible and implemented}
+\usage{
+check_SWRC_vs_PTF(swrc_name, ptf_name, fail = FALSE)
+}
+\arguments{
+\item{swrc_name}{An character string or vector.
+The selected \code{SWRC} name
+(one of \code{\link[=swrc_names]{swrc_names()}}, with default \code{"Campbell1974"}).}
+
+\item{ptf_name}{An character string or vector.
+The selected \code{PTF} name
+(one of \code{\link[=ptf_names]{ptf_names()}}, with default \code{"Cosby1984AndOthers"}).}
+
+\item{fail}{A logical value.
+Issue a warning (\code{FALSE}, default) or throw an error (\code{TRUE})
+if request fails.}
+}
+\value{
+A logical vector.
+}
+\description{
+Check whether \code{PTF} and \code{SWRC} are compatible and implemented
+}
+\examples{
+check_SWRC_vs_PTF("Campbell1974", c("Cosby1984", "Rosetta3"))
+
+}
diff --git a/man/check_content.Rd b/man/check_content.Rd
index 8e991d0e..6a9106eb 100644
--- a/man/check_content.Rd
+++ b/man/check_content.Rd
@@ -25,23 +25,35 @@ dbW_have_sites_all_weatherData(
site_ids = NULL,
scen_labels = NULL,
scen_ids = NULL,
- chunk_size = 1500L,
verbose = FALSE
)
}
\arguments{
-\item{Labels}{A vector of character strings. The names/labels of the queried
-sites.}
+\item{Labels}{A vector of character strings. The names/labels of
+queried sites.}
\item{ignore.case}{A logical value.}
-\item{Site_ids}{An integer vector. The IDs/database keys of the queried site.}
+\item{Site_ids}{An integer vector. The IDs/database keys of the queried sites}
\item{Scenario_ids}{An integer vector. The IDs/database keys of the queried
scenario.}
-\item{Scenarios}{A vector of character strings. The names/labels of the
-queried scenarios.}
+\item{Scenarios}{A vector of character strings. The climate scenarios of
+which the first one is enforced to be \code{scen_ambient}.}
+
+\item{site_labels}{A vector of character string. The names/labels of
+queried sites.}
+
+\item{site_ids}{An integer vector. The IDs/database keys of the queried sites}
+
+\item{scen_labels}{A vector of character strings. The climate scenarios of
+which the first one is enforced to be \code{scen_ambient}.}
+
+\item{scen_ids}{An integer vector. The IDs/database keys of the queried
+scenario.}
+
+\item{verbose}{A logical value.}
}
\value{
\code{dbW_has_siteIDs} returns a logical vector of the length of
diff --git a/man/check_ptf_availability.Rd b/man/check_ptf_availability.Rd
new file mode 100644
index 00000000..408dc088
--- /dev/null
+++ b/man/check_ptf_availability.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{check_ptf_availability}
+\alias{check_ptf_availability}
+\title{Check availability of \code{PTFs}}
+\usage{
+check_ptf_availability(ptfs = names(ptf_names()), verbose = interactive())
+}
+\arguments{
+\item{ptfs}{A character vector. \code{PTF} names to be checked;
+defaults to \code{\link[=ptf_names]{ptf_names()}}.}
+
+\item{verbose}{A logical value.}
+}
+\value{
+A named logical vector with current availability of \code{PTFs};
+\code{PTFs} that are not implemented return \code{NA}.
+}
+\description{
+\code{PTFs} implemented in \code{SOILWAT2} are always available;
+\code{PTFs} implemented in \code{rSOILWAT2} may have additional requirements, e.g.,
+live internet connection or access to specific data files.
+}
+\examples{
+check_ptf_availability()
+check_ptf_availability("neuroFX2021")
+check_ptf_availability("nonexistent_PTF")
+
+}
diff --git a/man/check_swrcp.Rd b/man/check_swrcp.Rd
new file mode 100644
index 00000000..46df58c0
--- /dev/null
+++ b/man/check_swrcp.Rd
@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{check_swrcp}
+\alias{check_swrcp}
+\title{Check Soil Water Retention Curve parameters}
+\usage{
+check_swrcp(swrc_name, swrcp)
+}
+\arguments{
+\item{swrc_name}{An character string or vector.
+The selected \code{SWRC} name
+(one of \code{\link[=swrc_names]{swrc_names()}}, with default \code{"Campbell1974"}).}
+
+\item{swrcp}{A numeric vector or matrix.
+The parameters of a selected \code{SWRC};
+each row represents one \code{SWRC}, e.g., one per soil layer.}
+}
+\description{
+Check Soil Water Retention Curve parameters
+}
+\section{Notes}{
+
+The argument selecting \code{SWRC} (\code{swrc_name}) is recycled
+for multiple parameter sets, i.e., rows of \code{swrcp}.
+}
+
+\section{Details}{
+
+\code{\link[=swrc_names]{swrc_names()}} lists implemented \code{SWRCs}.
+}
+
+\examples{
+swrc_name <- "Campbell1974"
+ptf_name <- "Cosby1984AndOthers"
+swrcp <- ptf_estimate(
+ sand = c(0.5, 0.3),
+ clay = c(0.2, 0.1),
+ fcoarse = c(0, 0),
+ swrc_name = swrc_name,
+ ptf_name = ptf_name
+)
+
+check_swrcp(swrc_name, swrcp)
+check_swrcp(swrc_name, swrcp[1, ])
+
+swrcp2 <- swrcp
+swrcp2[1, 1] <- -10
+check_swrcp(swrc_name, swrcp2)
+
+}
+\seealso{
+\code{\link[=ptf_estimate]{ptf_estimate()}}
+}
diff --git a/man/check_updatedDB.Rd b/man/check_updatedDB.Rd
new file mode 100644
index 00000000..6f91c94e
--- /dev/null
+++ b/man/check_updatedDB.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_upgrade.R
+\name{check_updatedDB}
+\alias{check_updatedDB}
+\title{Run database integrity checks on a weather database}
+\usage{
+check_updatedDB(con)
+}
+\arguments{
+\item{con}{A \link[DBI:DBIConnection-class]{DBI::DBIConnection} object.
+The connection to a weather database.}
+}
+\description{
+Run database integrity checks on a weather database
+}
diff --git a/man/dbW_addFromFolders.Rd b/man/dbW_addFromFolders.Rd
new file mode 100644
index 00000000..a5abf0ea
--- /dev/null
+++ b/man/dbW_addFromFolders.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{dbW_addFromFolders}
+\alias{dbW_addFromFolders}
+\title{Read \code{SOILWAT2}-style weather data from disk and store in weather database}
+\usage{
+dbW_addFromFolders(
+ MetaData = NULL,
+ FoldersPath = ".",
+ ScenarioName = "Current",
+ weather_tag = "weath"
+)
+}
+\arguments{
+\item{MetaData}{A data frame. If not missing, then must contain columns
+(in that order) (name of site weather data) \code{folder},
+\code{lat} (site latitude),
+\code{long} (site longitude),
+\code{label} (name of site).}
+
+\item{FoldersPath}{A character string. The path to the folder that contains
+the site weather data folders.}
+
+\item{ScenarioName}{A character string. The scenario name represented by
+the data.}
+
+\item{weather_tag}{A character string. The file name tag that identifies
+the individual weather data files inside the site weather data folders.}
+}
+\description{
+Read \code{SOILWAT2}-style weather data from disk and store in weather database
+}
diff --git a/man/dbW_addScenarios.Rd b/man/dbW_addScenarios.Rd
index 4d6b1e52..e0046902 100644
--- a/man/dbW_addScenarios.Rd
+++ b/man/dbW_addScenarios.Rd
@@ -7,8 +7,8 @@
dbW_addScenarios(Scenarios, ignore.case = FALSE, verbose = FALSE)
}
\arguments{
-\item{Scenarios}{A vector of character strings. The names/labels of the
-queried scenarios.}
+\item{Scenarios}{A vector of character strings. The climate scenarios of
+which the first one is enforced to be \code{scen_ambient}.}
\item{ignore.case}{A logical value.}
diff --git a/man/dbW_addSite.Rd b/man/dbW_addSite.Rd
new file mode 100644
index 00000000..a57aa875
--- /dev/null
+++ b/man/dbW_addSite.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/rSOILWAT2_deprecated.R
+\name{dbW_addSite}
+\alias{dbW_addSite}
+\title{Add a new site description to a weather database}
+\usage{
+dbW_addSite(Site_id = NULL, lat = NULL, long = NULL, Label = NULL)
+}
+\arguments{
+\item{Site_id}{An integer value. The identification number of the site.}
+
+\item{lat}{A numeric value. The latitude of the site.}
+
+\item{long}{A numeric value. The longitude of the site.}
+
+\item{Label}{A character string. The name of the site.}
+}
+\description{
+Add a new site description to a weather database
+}
diff --git a/man/dbW_addSites.Rd b/man/dbW_addSites.Rd
index d0b778d9..2e958623 100644
--- a/man/dbW_addSites.Rd
+++ b/man/dbW_addSites.Rd
@@ -8,7 +8,7 @@ dbW_addSites(site_data, ignore.case = FALSE, verbose = FALSE)
}
\arguments{
\item{site_data}{A data.frame. The site data with column names
-\var{Latitude}, \var{Longitude}, and \var{Label}.}
+\code{Longitude}, \code{Latitude}, and \code{Label}.}
\item{ignore.case}{A logical value.}
@@ -16,8 +16,13 @@ dbW_addSites(site_data, ignore.case = FALSE, verbose = FALSE)
}
\value{
An invisible logical value indicating success with \code{TRUE} and
- failure with \code{FALSE}.
+failure with \code{FALSE}.
}
\description{
Adds new sites to a registered weather database
}
+\section{Details}{
+
+\code{site_data} requires columns \code{Longitude}, \code{Latitude}, and \code{Label}.
+}
+
diff --git a/man/dbW_addWeatherData.Rd b/man/dbW_addWeatherData.Rd
index 99c1d875..766d3f0c 100644
--- a/man/dbW_addWeatherData.Rd
+++ b/man/dbW_addWeatherData.Rd
@@ -21,22 +21,40 @@ dbW_addWeatherData(
)
}
\arguments{
-\item{Site_id}{Numeric. Used to identify site and extract weather data.}
+\item{Site_id}{An integer value. The IDs/database key of the queried site.}
-\item{lat}{Numeric. Latitude used with longitude to identify site id if
-\code{Site_id} is missing.}
+\item{lat}{A numeric vector or \code{NULL}. The latitude in decimal degrees
+of \code{WGS84}. Northern latitude are positive, sites on the southern
+hemisphere have negative values.}
-\item{long}{Numeric. Longitude and Latitude are used to identify site if
-\code{Site_id} is missing.}
+\item{long}{A numeric vector or \code{NULL}. The longitude in decimal degrees
+of \code{WGS84}. Eastern longitudes are positive, sites on the western
+hemisphere have negative values.}
\item{tol_xy}{A numeric value. The tolerance used to match requested
longitude and latitude values.}
-\item{Label}{A character string. A site label.}
+\item{weatherFolderPath}{A character string. The path to the parent folder.}
-\item{Scenario}{A character string.}
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{Label}{A character string. The name/label of the queried site.}
+
+\item{Scenario_id}{An integer value The ID/database key of the queried
+scenario.}
+
+\item{Scenario}{A character string. The name/label of a climate scenario.}
+
+\item{weather_tag}{A character string. The base file name without extension
+for \code{SOILWAT2}-formatted input files; default is \code{"weath"}}
\item{ignore.case}{A logical value.}
+
+\item{overwrite}{A logical value. Should weather data that already exists
+in the data base be overwritten?}
+
+\item{verbose}{A logical value.}
}
\value{
An invisible logical value indicating success with \code{TRUE} and
diff --git a/man/dbW_check_version.Rd b/man/dbW_check_version.Rd
index f2afc962..7d160880 100644
--- a/man/dbW_check_version.Rd
+++ b/man/dbW_check_version.Rd
@@ -6,6 +6,9 @@
\usage{
dbW_check_version(dbW_min_version = NULL)
}
+\arguments{
+\item{dbW_min_version}{A numeric version number.}
+}
\value{
A logical value.
}
diff --git a/man/dbW_check_weatherData.Rd b/man/dbW_check_weatherData.Rd
index dcee2413..59909cd8 100644
--- a/man/dbW_check_weatherData.Rd
+++ b/man/dbW_check_weatherData.Rd
@@ -4,10 +4,12 @@
\alias{dbW_check_weatherData}
\title{Check that weather data is well-formed}
\usage{
-dbW_check_weatherData(x)
+dbW_check_weatherData(x, check_all = TRUE)
}
\arguments{
\item{x}{An object.}
+
+\item{check_all}{A logical value}
}
\value{
A logical value.
@@ -17,3 +19,10 @@ Check that weather data is organized in a list
where each element is of class \code{\linkS4class{swWeatherData}}, and
represents daily data for one Gregorian year
}
+\examples{
+dbW_check_weatherData(rSOILWAT2::weatherData)
+dbW_check_weatherData(weatherHistory())
+dbW_check_weatherData(weatherHistory(), check_all = FALSE)
+
+
+}
diff --git a/man/dbW_convert_to_GregorianYears.Rd b/man/dbW_convert_to_GregorianYears.Rd
index b24f7a80..85215f34 100644
--- a/man/dbW_convert_to_GregorianYears.Rd
+++ b/man/dbW_convert_to_GregorianYears.Rd
@@ -11,14 +11,13 @@ dbW_convert_to_GregorianYears(
type = c("asis", "sequential"),
name_year = "Year",
name_DOY = "DOY",
- name_data = c("Tmax_C", "Tmin_C", "PPT_cm"),
+ name_data = weather_dataColumns(),
valNA = NULL
)
}
\arguments{
-\item{weatherData}{A list of elements of class
-\code{\linkS4class{swWeatherData}} or a \code{data.frame} as returned by
-\code{\link{dbW_weatherData_to_dataframe}}.}
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
\item{new_startYear}{An integer value. The first Calendar year of the new
time period. If \code{NULL}, then the first year of \code{weatherData}.}
@@ -62,25 +61,32 @@ can convert from a non-leap to a Gregorian calendar.
wdata <- rSOILWAT2::weatherData
## Transfer to different years (partially overlapping)
-wnew <- dbW_convert_to_GregorianYears(wdata,
- new_startYear = 2000, new_endYear = 2020
+wnew <- dbW_convert_to_GregorianYears(
+ wdata,
+ new_startYear = 2000,
+ new_endYear = 2020
)
all.equal(unique(wnew[, "Year"]), 2000:2020)
anyNA(wnew) # --> use `dbW_generateWeather`
## Transfer to a subset of years (i.e., subset)
-wnew <- dbW_convert_to_GregorianYears(wdata,
- new_startYear = 2000, new_endYear = 2005
+wnew <- dbW_convert_to_GregorianYears(
+ wdata,
+ new_startYear = 2000,
+ new_endYear = 2005
)
all.equal(unique(wnew[, "Year"]), 2000:2005)
anyNA(wnew)
## Correct/convert from a non-leap to a Gregorian calendar
-wempty <- data.frame(dbW_weatherData_to_dataframe(
- list(new("swWeatherData"))))[1:365, ]
+wempty <- data.frame(
+ dbW_weatherData_to_dataframe(weatherHistory())
+)[1:365, ]
-wnew <- dbW_convert_to_GregorianYears(wempty,
- new_startYear = 2016, new_endYear = 2016
+wnew <- dbW_convert_to_GregorianYears(
+ wempty,
+ new_startYear = 2016,
+ new_endYear = 2016
)
all.equal(unique(wnew[, "Year"]), 2016:2016)
all.equal(nrow(wnew), 366) # leap year
diff --git a/man/dbW_createDatabase.Rd b/man/dbW_createDatabase.Rd
index 1192d429..a16ba2e6 100644
--- a/man/dbW_createDatabase.Rd
+++ b/man/dbW_createDatabase.Rd
@@ -21,7 +21,7 @@ This will be a file of type \code{sqlite3}. In-memory databases are not
supported.}
\item{site_data}{A data.frame. The site data with column names
-\var{Latitude}, \var{Longitude}, and \var{Label}.}
+\code{Longitude}, \code{Latitude}, and \code{Label}.}
\item{Scenarios}{A vector of character strings. The climate scenarios of
which the first one is enforced to be \code{scen_ambient}.}
@@ -59,5 +59,8 @@ Create a weather database
\item{Table \var{Scenarios}}{contains two fields \var{id} and
\var{Scenario} (i.e., the scenario name)}
}
+
+
+`site_data` requires columns `Longitude`, `Latitude`, and `Label`.
}
diff --git a/man/dbW_dataframe_aggregate.Rd b/man/dbW_dataframe_aggregate.Rd
deleted file mode 100644
index a43c1e5a..00000000
--- a/man/dbW_dataframe_aggregate.Rd
+++ /dev/null
@@ -1,15 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_dbW_WeatherDatabase.R
-\name{dbW_dataframe_aggregate}
-\alias{dbW_dataframe_aggregate}
-\title{Aggregate daily weather data.frame to weekly, monthly, or yearly values}
-\usage{
-dbW_dataframe_aggregate(
- dailySW,
- time_step = c("Year", "Month", "Week", "Day"),
- na.rm = FALSE
-)
-}
-\description{
-Aggregate daily weather data.frame to weekly, monthly, or yearly values
-}
diff --git a/man/dbW_dataframe_to_monthly.Rd b/man/dbW_dataframe_to_monthly.Rd
deleted file mode 100644
index 11e24c74..00000000
--- a/man/dbW_dataframe_to_monthly.Rd
+++ /dev/null
@@ -1,13 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_dbW_WeatherDatabase.R
-\name{dbW_dataframe_to_monthly}
-\alias{dbW_dataframe_to_monthly}
-\title{Conversion: object of daily weather data.frame to matrix of monthly values
-(\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})}
-\usage{
-dbW_dataframe_to_monthly(dailySW, na.rm = FALSE)
-}
-\description{
-Conversion: object of daily weather data.frame to matrix of monthly values
-(\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})
-}
diff --git a/man/dbW_dataframe_to_weatherData.Rd b/man/dbW_dataframe_to_weatherData.Rd
index 7daf2f4e..ef63b7ee 100644
--- a/man/dbW_dataframe_to_weatherData.Rd
+++ b/man/dbW_dataframe_to_weatherData.Rd
@@ -7,10 +7,31 @@
dbW_dataframe_to_weatherData(
weatherDF,
years = NULL,
- weatherDF_dataColumns = c("DOY", "Tmax_C", "Tmin_C", "PPT_cm"),
+ weatherDF_dataColumns = c("DOY", weather_dataColumns()),
round = 2
)
}
+\arguments{
+\item{weatherDF}{A \code{data.frame}. Daily weather data where rows represent
+days and columns represent the weather variables
+(see \code{weatherDF_dataColumns}).}
+
+\item{years}{A numeric vector. The calendar years.}
+
+\item{weatherDF_dataColumns}{A vector of character strings. The column
+names of \code{weatherDF} in the correct order for \code{SOILWAT2} including
+calendar year \code{year} (optional) and day of year \code{DOY}, see
+\code{\link[=weather_dataColumns]{weather_dataColumns()}}.}
+
+\item{round}{An integer value. The number of decimal places for rounding
+weather values.}
+}
\description{
Conversion: data.frame to object of class \code{\linkS4class{swWeatherData}}
}
+\section{Notes}{
+
+\code{weatherDF_dataColumns} must exactly contain entries for day of year and
+the three weather variables.
+}
+
diff --git a/man/dbW_deleteSite.Rd b/man/dbW_deleteSite.Rd
index ef782151..c2803f36 100644
--- a/man/dbW_deleteSite.Rd
+++ b/man/dbW_deleteSite.Rd
@@ -8,7 +8,7 @@ database}
dbW_deleteSite(Site_ids)
}
\arguments{
-\item{Site_ids}{An integer vector. The IDs/database keys of the queried site.}
+\item{Site_ids}{An integer vector. The IDs/database keys of the queried sites}
}
\value{
An invisible logical value indicating success with \code{TRUE} and
diff --git a/man/dbW_deleteSiteData.Rd b/man/dbW_deleteSiteData.Rd
index de16226c..3ea8c1f9 100644
--- a/man/dbW_deleteSiteData.Rd
+++ b/man/dbW_deleteSiteData.Rd
@@ -6,6 +6,12 @@
\usage{
dbW_deleteSiteData(Site_id, Scenario_id = NULL)
}
+\arguments{
+\item{Site_id}{An integer value. The IDs/database key of the queried site.}
+
+\item{Scenario_id}{An integer value The ID/database key of the queried
+scenario.}
+}
\value{
An invisible logical value indicating success with \code{TRUE} and
failure with \code{FALSE}.
diff --git a/man/dbW_generateWeather.Rd b/man/dbW_generateWeather.Rd
index 1210f155..0af0fca6 100644
--- a/man/dbW_generateWeather.Rd
+++ b/man/dbW_generateWeather.Rd
@@ -10,6 +10,7 @@ dbW_generateWeather(
wgen_coeffs = NULL,
imputation_type = "mean",
imputation_span = 5L,
+ digits = 4L,
seed = NULL
)
}
@@ -41,6 +42,9 @@ based on \code{weatherData}.}
\item{imputation_span}{An integer value. The number of non-missing values
considered if \code{imputation_type = "mean"}.}
+\item{digits}{An integer value. The returned values will be rounded to
+the specified number of decimal places.}
+
\item{seed}{An integer value or \code{NULL}. See \code{\link{set.seed}}.}
}
\value{
@@ -50,6 +54,16 @@ A list of elements of class \code{\linkS4class{swWeatherData}}.
This function is a convenience wrapper for
\code{\link{dbW_estimate_WGen_coefs}}.
}
+\section{Details}{
+
+The current implementation of the weather generator produces values
+only for variables in \code{\link[=weatherGenerator_dataColumns]{weatherGenerator_dataColumns()}}.
+Values are generated for those days where at least one of the implemented
+variables is missing; if any value is missing, then values for that day of
+all implemented variables will be replaced by those produced
+by the weather generator.
+}
+
\examples{
# Load data for 1949-2010
wdata <- data.frame(dbW_weatherData_to_dataframe(rSOILWAT2::weatherData))
@@ -84,7 +98,7 @@ wout2 <- dbW_generateWeather(
## Example 3: generate weather based only on estimated weather generator
## coefficients from a different dataset
-x_empty <- list(new("swWeatherData"))
+x_empty <- weatherHistory()
wout3 <- dbW_generateWeather(
x_empty,
years = 2050:2055,
diff --git a/man/dbW_getIDs.Rd b/man/dbW_getIDs.Rd
index 64281437..14a18643 100644
--- a/man/dbW_getIDs.Rd
+++ b/man/dbW_getIDs.Rd
@@ -18,18 +18,32 @@ dbW_getIDs(
)
}
\arguments{
+\item{site_id}{An integer value. The IDs/database key of the queried site.}
+
+\item{site_label}{A character string. The name/label of the queried site.}
+
\item{long}{A numeric vector or \code{NULL}. The longitude in decimal degrees
-of \var{WGS84}. Eastern longitudes are positive, sites on the western
+of \code{WGS84}. Eastern longitudes are positive, sites on the western
hemisphere have negative values.}
\item{lat}{A numeric vector or \code{NULL}. The latitude in decimal degrees
-of \var{WGS84}. Northern latitude are positive, sites on the southern
+of \code{WGS84}. Northern latitude are positive, sites on the southern
hemisphere have negative values.}
\item{tol_xy}{A numeric value. The tolerance used to match requested
longitude and latitude values.}
+\item{scenario}{A character string. The name/label of a climate scenario.}
+
+\item{scenario_id}{An integer value The ID/database key of the queried
+scenario.}
+
+\item{add_if_missing}{A logical value. Should site entries in the data base
+be created if they are queried and do not exist in the data base?}
+
\item{ignore.case}{A logical value.}
+
+\item{verbose}{A logical value.}
}
\value{
A list with two elements \code{site_id} and \code{scenario_id}.
diff --git a/man/dbW_getScenarioId.Rd b/man/dbW_getScenarioId.Rd
index bfa6d6e8..4be9f5a8 100644
--- a/man/dbW_getScenarioId.Rd
+++ b/man/dbW_getScenarioId.Rd
@@ -8,7 +8,11 @@ weather database}
dbW_getScenarioId(Scenario, ignore.case = FALSE, verbose = FALSE)
}
\arguments{
+\item{Scenario}{A character string. The name/label of a climate scenario.}
+
\item{ignore.case}{A logical value.}
+
+\item{verbose}{A logical value.}
}
\value{
An integer vector with the values of the keys or \code{NA} if not
diff --git a/man/dbW_getSiteId.Rd b/man/dbW_getSiteId.Rd
index 425a8427..0f28ce0b 100644
--- a/man/dbW_getSiteId.Rd
+++ b/man/dbW_getSiteId.Rd
@@ -16,20 +16,22 @@ dbW_getSiteId(
}
\arguments{
\item{lat}{A numeric vector or \code{NULL}. The latitude in decimal degrees
-of \var{WGS84}. Northern latitude are positive, sites on the southern
+of \code{WGS84}. Northern latitude are positive, sites on the southern
hemisphere have negative values.}
\item{long}{A numeric vector or \code{NULL}. The longitude in decimal degrees
-of \var{WGS84}. Eastern longitudes are positive, sites on the western
+of \code{WGS84}. Eastern longitudes are positive, sites on the western
hemisphere have negative values.}
\item{tol_xy}{A numeric value. The tolerance used to match requested
longitude and latitude values.}
-\item{Labels}{A vector of character strings. The names/labels of the queried
-sites.}
+\item{Labels}{A vector of character strings. The names/labels of
+queried sites.}
\item{ignore.case}{A logical value.}
+
+\item{verbose}{A logical value.}
}
\value{
An integer vector with the values of the keys or \code{NA} if not
diff --git a/man/dbW_getWeatherData.Rd b/man/dbW_getWeatherData.Rd
index 39dbeb42..26cf765a 100644
--- a/man/dbW_getWeatherData.Rd
+++ b/man/dbW_getWeatherData.Rd
@@ -20,24 +20,29 @@ dbW_getWeatherData(
)
}
\arguments{
-\item{Site_id}{Numeric. Used to identify site and extract weather data.}
+\item{Site_id}{An integer value. The IDs/database key of the queried site.}
-\item{lat}{Numeric. Latitude used with longitude to identify site id if
-\code{Site_id} is missing.}
+\item{lat}{A numeric vector or \code{NULL}. The latitude in decimal degrees
+of \code{WGS84}. Northern latitude are positive, sites on the southern
+hemisphere have negative values.}
-\item{long}{Numeric. Longitude and Latitude are used to identify site if
-\code{Site_id} is missing.}
+\item{long}{A numeric vector or \code{NULL}. The longitude in decimal degrees
+of \code{WGS84}. Eastern longitudes are positive, sites on the western
+hemisphere have negative values.}
\item{tol_xy}{A numeric value. The tolerance used to match requested
longitude and latitude values.}
-\item{Label}{A character string. A site label.}
+\item{Label}{A character string. The name/label of the queried site.}
-\item{startYear}{Numeric. Extracted weather data will start with this year.}
+\item{startYear}{A numeric value. First calendar year of the weather data.}
-\item{endYear}{Numeric. Extracted weather data will end with this year.}
+\item{endYear}{A numeric value. Last calendar year of the weather data.}
-\item{Scenario}{A character string.}
+\item{Scenario}{A character string. The name/label of a climate scenario.}
+
+\item{Scenario_id}{An integer value The ID/database key of the queried
+scenario.}
\item{ignore.case}{A logical value.}
@@ -45,16 +50,18 @@ longitude and latitude values.}
error if at least one requested weather data object is not available
in the current weather database. If \code{FALSE}, then returns \code{NULL}
for those requested site scenario combinations.}
+
+\item{verbose}{A logical value.}
}
\value{
If one site and one scenario were requested, then returns
- weather data as list. Each element is an object of class
- \code{\linkS4class{swWeatherData}} and contains data for one year.
- If more than one site or more than scenario were requested, then returns
- a list of such weather data lists.
- Elements of the returned list may be \code{NULL} if there is no
- weather data object for the requested site scenario combination and if
- \code{stop_if_missing} is \code{FALSE}.
+weather data as list. Each element is an object of class
+\code{\linkS4class{swWeatherData}} and contains data for one year.
+If more than one site or more than scenario were requested, then returns
+a list of such weather data lists.
+Elements of the returned list may be \code{NULL} if there is no
+weather data object for the requested site scenario combination and if
+\code{stop_if_missing} is \code{FALSE}.
}
\description{
Weather data for the soil water simulation run can be stored in the input
@@ -69,8 +76,8 @@ weather generator (see examples for \code{\link{sw_exec}}).
}
\section{Notes}{
- This function returns the first record of weather data for a
- site x scenario combination even if duplicate entries match the query.
+This function returns the first record of weather data for a
+site x scenario combination even if duplicate entries match the query.
}
\seealso{
diff --git a/man/dbW_setConnection.Rd b/man/dbW_setConnection.Rd
index 73a7de3e..e98cd35f 100644
--- a/man/dbW_setConnection.Rd
+++ b/man/dbW_setConnection.Rd
@@ -15,10 +15,12 @@ dbW_setConnection(
.dbW_setConnection(dbFilePath)
}
\arguments{
-\item{dbFilePath}{A character string. The weather database file path.}
+\item{dbFilePath}{A character string. The file path of the weather database.
+This will be a file of type \code{sqlite3}. In-memory databases are not
+supported.}
-\item{create_if_missing}{A logical value. If \code{TRUE} and now file
-\code{dbFilePath} exists then create a new file.}
+\item{create_if_missing}{A logical value. If \code{TRUE} and file
+\code{dbFilePath} does not exist then create a new database file.}
\item{check_version}{A logical value. If \code{TRUE} then check database
version against currently implemented version by the package.}
@@ -33,7 +35,7 @@ Registers/connects a SQLite weather database with the package
}
\section{Details}{
-\code{.dbW_setConnection()} is a bare-bones version of \code{dbW_setConnection()}.
+\code{\link[=.dbW_setConnection]{.dbW_setConnection()}} is a bare-bones version of \code{\link[=dbW_setConnection]{dbW_setConnection()}}.
It doesn't carry out any checks that make sure the database works
correctly.
}
diff --git a/man/dbW_temporal_summaries.Rd b/man/dbW_temporal_summaries.Rd
new file mode 100644
index 00000000..32133245
--- /dev/null
+++ b/man/dbW_temporal_summaries.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{dbW_temporal_summaries}
+\alias{dbW_temporal_summaries}
+\alias{dbW_weatherData_to_monthly}
+\alias{dbW_dataframe_aggregate}
+\alias{dbW_dataframe_to_monthly}
+\title{Summarize daily weather to weekly, monthly, or yearly values}
+\usage{
+dbW_weatherData_to_monthly(
+ dailySW,
+ na.rm = FALSE,
+ valNA = NULL,
+ funs = weather_dataAggFun()
+)
+
+dbW_dataframe_aggregate(
+ dailySW,
+ time_step = c("Year", "Month", "Week", "Day"),
+ na.rm = FALSE,
+ funs = weather_dataAggFun()
+)
+
+dbW_dataframe_to_monthly(dailySW, na.rm = FALSE)
+}
+\arguments{
+\item{dailySW}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{na.rm}{A logical value. Should missing daily values be removed before
+calculating monthly temperature and precipitation.}
+
+\item{valNA}{The (numerical) value of missing weather data.
+If \code{NULL}, then default values are interpreted as missing.}
+
+\item{funs}{A named vector of functions. The names must match column names
+in \code{dailySW} and the function are used to summarize daily weather values.}
+
+\item{time_step}{A character string.}
+}
+\description{
+Summarize daily weather to weekly, monthly, or yearly values
+}
diff --git a/man/dbW_updateSites.Rd b/man/dbW_updateSites.Rd
index 6f61d1ff..1ac44769 100644
--- a/man/dbW_updateSites.Rd
+++ b/man/dbW_updateSites.Rd
@@ -7,10 +7,10 @@
dbW_updateSites(Site_ids, site_data, ignore.case = FALSE, verbose = FALSE)
}
\arguments{
-\item{Site_ids}{An integer vector. The IDs/database keys of the queried site.}
+\item{Site_ids}{An integer vector. The IDs/database keys of the queried sites}
\item{site_data}{A data.frame. The site data with column names
-\var{Latitude}, \var{Longitude}, and \var{Label}.}
+\code{Longitude}, \code{Latitude}, and \code{Label}.}
\item{ignore.case}{A logical value.}
diff --git a/man/dbW_upgrade.Rd b/man/dbW_upgrade.Rd
index 4b50db20..5cf587cd 100644
--- a/man/dbW_upgrade.Rd
+++ b/man/dbW_upgrade.Rd
@@ -58,6 +58,8 @@ removed once upgrade completed successfully.}
\item{type_new}{The type of compression used to compress the weather blobs.
See \code{\link[base]{memCompress}}.}
+
+\item{SWRunInformation}{A data frame.}
}
\description{
Weather database upgrade functions
diff --git a/man/dbW_weatherData_round.Rd b/man/dbW_weatherData_round.Rd
new file mode 100644
index 00000000..7751263c
--- /dev/null
+++ b/man/dbW_weatherData_round.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{dbW_weatherData_round}
+\alias{dbW_weatherData_round}
+\title{Round weather data in a list class \code{\linkS4class{swWeatherData}}}
+\usage{
+dbW_weatherData_round(
+ weatherData,
+ digits = 4L,
+ weatherDF_dataColumns = weather_dataColumns()
+)
+}
+\arguments{
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{digits}{An integer value. The number of decimal places for rounding
+weather values.}
+
+\item{weatherDF_dataColumns}{A vector of character strings. The column
+names of \code{weatherDF} in the correct order for \code{SOILWAT2} including
+calendar year \code{year} (optional) and day of year \code{DOY}, see
+\code{\link[=weather_dataColumns]{weather_dataColumns()}}.}
+}
+\value{
+A list with \code{\linkS4class{swWeatherData}} elements.
+}
+\description{
+Round weather data in a list class \code{\linkS4class{swWeatherData}}
+}
+\section{Notes}{
+
+\code{weatherDF_dataColumns} lists the columns of \code{weatherData} to be rounded.
+}
+
diff --git a/man/dbW_weatherData_to_blob.Rd b/man/dbW_weatherData_to_blob.Rd
index d6349322..cbdb38a0 100644
--- a/man/dbW_weatherData_to_blob.Rd
+++ b/man/dbW_weatherData_to_blob.Rd
@@ -7,11 +7,11 @@
dbW_weatherData_to_blob(weatherData, type = "gzip")
}
\arguments{
-\item{weatherData}{A list of elements of class
-\code{\linkS4class{swWeatherData}} or any suitable object.}
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
-\item{type}{A character string. One of
-\code{c("gzip", "bzip2", "xz", "none")}.}
+\item{type}{A character string. One of \code{c("gzip", "bzip2", "xz",
+"none")}.}
}
\description{
The \pkg{rSOILWAT2} database which manages daily weather data (each as a
diff --git a/man/dbW_weatherData_to_dataframe.Rd b/man/dbW_weatherData_to_dataframe.Rd
index b3d94629..e6c3de16 100644
--- a/man/dbW_weatherData_to_dataframe.Rd
+++ b/man/dbW_weatherData_to_dataframe.Rd
@@ -7,6 +7,9 @@
dbW_weatherData_to_dataframe(weatherData, valNA = NULL)
}
\arguments{
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
\item{valNA}{The (numerical) value of missing weather data.
If \code{NULL}, then default values are interpreted as missing.}
}
diff --git a/man/dbW_weatherData_to_monthly.Rd b/man/dbW_weatherData_to_monthly.Rd
deleted file mode 100644
index acb3bad5..00000000
--- a/man/dbW_weatherData_to_monthly.Rd
+++ /dev/null
@@ -1,17 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_dbW_WeatherDatabase.R
-\name{dbW_weatherData_to_monthly}
-\alias{dbW_weatherData_to_monthly}
-\title{Conversion: object of class \code{\linkS4class{swWeatherData}} to
-matrix of monthly values (\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})}
-\usage{
-dbW_weatherData_to_monthly(dailySW, na.rm = FALSE, valNA = NULL)
-}
-\arguments{
-\item{valNA}{The (numerical) value of missing weather data.
-If \code{NULL}, then default values are interpreted as missing.}
-}
-\description{
-Conversion: object of class \code{\linkS4class{swWeatherData}} to
-matrix of monthly values (\var{mean Tmax}, \var{mean Tmin}, \var{sum PPT})
-}
diff --git a/man/dbW_weather_to_SOILWATfiles.Rd b/man/dbW_weather_to_SOILWATfiles.Rd
index 53513dfc..74802547 100644
--- a/man/dbW_weather_to_SOILWATfiles.Rd
+++ b/man/dbW_weather_to_SOILWATfiles.Rd
@@ -11,10 +11,49 @@ dbW_weather_to_SOILWATfiles(
weatherData = NULL,
weatherDF = NULL,
years = NULL,
- weatherDF_dataColumns = c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
+ weatherDF_dataColumns = c("DOY", weather_dataColumns()),
+ digits = 4L
)
}
+\arguments{
+\item{path}{A character string. Path on disk to where to write files.}
+
+\item{site.label}{A character string. Site identification name added to
+comment on first line of each file.}
+
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{weatherDF}{A data.frame. Weather data, see details.}
+
+\item{years}{A numeric vector. The calendar years.}
+
+\item{weatherDF_dataColumns}{A vector of character strings. The column
+names of \code{weatherDF} in the correct order for \code{SOILWAT2} including
+calendar year \code{year} (optional) and day of year \code{DOY}, see
+\code{\link[=weather_dataColumns]{weather_dataColumns()}}.}
+
+\item{digits}{An integer value. The number of decimal places for rounding
+weather values.}
+}
\description{
Conversion: object of class \code{\linkS4class{swWeatherData}} or
data.frame to \pkg{SOILWAT} input text files
}
+\section{Notes}{
+
+\code{weatherDF_dataColumns} must exactly contain entries for day of year and
+the three weather variables.
+}
+
+\section{Details}{
+
+The weather data must be provided either via \code{weatherData} or \code{weatherDF}.
+See \code{\link[=dbW_weatherData_to_dataframe]{dbW_weatherData_to_dataframe()}} and \code{\link[=dbW_weatherData_to_dataframe]{dbW_weatherData_to_dataframe()}}
+for conversions between formats of \code{weatherData} and \code{weatherDF}.
+
+
+\code{\link[=getWeatherData_folders]{getWeatherData_folders()}} offers the inverse operation, i.e.,
+reading weather data from disk files.
+}
+
diff --git a/man/estimate_PotNatVeg_biomass.Rd b/man/estimate_PotNatVeg_biomass.Rd
index 59a7d0d3..52553d99 100644
--- a/man/estimate_PotNatVeg_biomass.Rd
+++ b/man/estimate_PotNatVeg_biomass.Rd
@@ -20,6 +20,9 @@ estimate_PotNatVeg_biomass(
temperature values in degree Celsius of a target site / condition
for which \code{x} is to be adjusted.}
+\item{target_MAP_mm}{A numeric value. Mean annual precipitation
+in millimeter of the location.}
+
\item{ref_temp}{A numeric vector of length 12. Reference mean monthly
temperature values in degree Celsius under which \code{x} was
determined / is valid.}
@@ -39,16 +42,13 @@ phenology is adjusted by temperature.}
is adjusted by precipitation.}
\item{fgrass_c3c4ann}{A numeric vector of length 3. Relative contribution
-[0-1] of the C3-grasses, C4-grasses, and annuals functional groups. The sum
-of \code{fgrass_c3c4ann} is 1.}
-
-\item{MAP_mm}{A numeric value. Mean annual precipitation in millimeter of the
-location.}
+\verb{[0-1]} of the C3-grasses, C4-grasses, and annuals functional groups.
+The sum of \code{fgrass_c3c4ann} is 1.}
}
\value{
A list with two elements \code{grass}, \code{shrub}. Each element is
- a matrix with 12 rows (one for each month) and columns \code{Biomass},
- \code{Amount.Live}, \code{Perc.Live}, and \code{Litter}.
+a matrix with 12 rows (one for each month) and columns \code{Biomass},
+\code{Amount.Live}, \code{Perc.Live}, and \code{Litter}.
}
\description{
Adjust mean monthly biomass values of grass and shrub functional groups by
@@ -56,18 +56,27 @@ climate relationships
}
\section{Default inputs}{
\itemize{
- \item Shrubs are based on location \var{\sQuote{IM_USC00107648_Reynolds}}
- which resulted in a vegetation composition of 70 \% shrubs and 30 \%
- C3-grasses. Default monthly biomass values were estimated for
- MAP = 450 mm yr-1.
- \item Grasses are based on location \var{\sQuote{GP_SGSLTER}}
- (shortgrass steppe) which resulted in 12 \% shrubs, 22 \% C3-grasses,
- and 66 \% C4-grasses. Default biomass values were estimated for
- MAP = 340 mm yr-1.
- \item Mean monthly reference temperature are the median values across
- 898 big sagebrush sites
- (see \url{https://github.com/DrylandEcology/rSFSTEP2/issues/195})
+\item Shrubs are based on location \var{\sQuote{IM_USC00107648_Reynolds}}
+which resulted in a vegetation composition of 70 \% shrubs and 30 \%
+C3-grasses. Default monthly biomass values were estimated for
+MAP = 450 mm yr-1.
+\item Grasses are based on location \var{\sQuote{GP_SGSLTER}}
+(shortgrass steppe) which resulted in 12 \% shrubs, 22 \% C3-grasses,
+and 66 \% C4-grasses. Default biomass values were estimated for
+MAP = 340 mm yr-1.
+\item Mean monthly reference temperature are the median values across
+898 big sagebrush sites
+(see \url{https://github.com/DrylandEcology/rSFSTEP2/issues/195})
+}
}
+
+\section{Details}{
+
+If \code{do_adjust_biomass}, then the internal function \code{adjBiom_by_ppt()} is
+used to adjust biomass by annual precipitation amount.
+If \code{do_adjust_phenology}, then the exported function
+\code{\link[=adj_phenology_by_temp]{adj_phenology_by_temp()}} is used to adjust the seasonal pattern of biomass
+(phenology) by monthly temperature.
}
\examples{
@@ -92,13 +101,7 @@ rSOILWAT2::estimate_PotNatVeg_biomass(
}
\references{
Bradford, J.B., Schlaepfer, D.R., Lauenroth, W.K. & Burke, I.C.
- (2014). Shifts in plant functional types have time-dependent and regionally
- variable impacts on dryland ecosystem water balance. J Ecol, 102,
- 1408-1418.
-}
-\seealso{
-Function \code{\link{adjBiom_by_ppt}} is called
- if \code{do_adjust_biomass};
- function \code{\link{adj_phenology_by_temp}} is called
- if \code{do_adjust_phenology}.
+(2014). Shifts in plant functional types have time-dependent and regionally
+variable impacts on dryland ecosystem water balance. J Ecol, 102,
+1408-1418.
}
diff --git a/man/estimate_PotNatVeg_composition.Rd b/man/estimate_PotNatVeg_composition.Rd
index 39f9ea41..594bad71 100644
--- a/man/estimate_PotNatVeg_composition.Rd
+++ b/man/estimate_PotNatVeg_composition.Rd
@@ -194,7 +194,8 @@ clim2 <- calc_SiteClimate(weatherList = weatherData, do_C4vars = TRUE)
## All estimable vegetation types are estimated:
estimate_PotNatVeg_composition(
- MAP_mm = 10 * clim1[["MAP_cm"]], MAT_C = clim1[["MAT_C"]],
+ MAP_mm = 10 * clim1[["MAP_cm"]],
+ MAT_C = clim1[["MAT_C"]],
mean_monthly_ppt_mm = 10 * clim1[["meanMonthlyPPTcm"]],
mean_monthly_Temp_C = clim1[["meanMonthlyTempC"]]
)
@@ -210,7 +211,8 @@ estimate_PotNatVeg_composition(
## Some land cover types are fixed and others are estimated, and
## the C4-grass adjustment is used:
estimate_PotNatVeg_composition(
- MAP_mm = 10 * clim2[["MAP_cm"]], MAT_C = clim2[["MAT_C"]],
+ MAP_mm = 10 * clim2[["MAP_cm"]],
+ MAT_C = clim2[["MAT_C"]],
mean_monthly_ppt_mm = 10 * clim2[["meanMonthlyPPTcm"]],
mean_monthly_Temp_C = clim2[["meanMonthlyTempC"]],
dailyC4vars = clim2[["dailyC4vars"]],
@@ -221,14 +223,43 @@ estimate_PotNatVeg_composition(
## Fix total grass cover and annual grass cover,
## but estimate relative proportions of C3 and C4 grasses:
estimate_PotNatVeg_composition(
- MAP_mm = 10 * clim2[["MAP_cm"]], MAT_C = clim2[["MAT_C"]],
+ MAP_mm = 10 * clim2[["MAP_cm"]],
+ MAT_C = clim2[["MAT_C"]],
mean_monthly_ppt_mm = 10 * clim2[["meanMonthlyPPTcm"]],
mean_monthly_Temp_C = clim2[["meanMonthlyTempC"]],
dailyC4vars = clim2[["dailyC4vars"]],
- fix_sumgrasses = TRUE, SumGrasses_Fraction = 0.8,
- fix_annuals = TRUE, Annuals_Fraction = 0.3
+ fix_sumgrasses = TRUE,
+ SumGrasses_Fraction = 0.8,
+ fix_annuals = TRUE,
+ Annuals_Fraction = 0.3
)
+
+## SOILWAT2 uses the same algorithm internally if requested to do so
+# Obtain cover values from SOILWAT2 output
+swin <- rSOILWAT2::sw_exampleData
+swin@prod@veg_method <- 1L
+swout <- sw_exec(swin)
+tmp <- slot(slot(swout, "BIOMASS"), "Year")
+pnvsim <- tmp[1, grep("fCover", colnames(tmp)), drop = TRUE]
+
+# Directly calculate cover values
+climex <- calc_SiteClimate(weatherList = get_WeatherHistory(swin))
+pnvex <- estimate_PotNatVeg_composition(
+ MAP_mm = 10 * climex[["MAP_cm"]],
+ MAT_C = climex[["MAT_C"]],
+ mean_monthly_ppt_mm = 10 * climex[["meanMonthlyPPTcm"]],
+ mean_monthly_Temp_C = climex[["meanMonthlyTempC"]]
+)[["Rel_Abundance_L1"]]
+
+# They are identical
+identical(pnvsim[["fCover_shrub"]], pnvex[["SW_SHRUB"]])
+identical(pnvsim[["fCover_grass"]], pnvex[["SW_GRASS"]])
+identical(pnvsim[["fCover_forbs"]], pnvex[["SW_FORBS"]])
+identical(pnvsim[["fCover_tree"]], pnvex[["SW_TREES"]])
+identical(pnvsim[["fCover_BareGround"]], pnvex[["SW_BAREGROUND"]])
+
+
}
\references{
Paruelo J.M., Lauenroth W.K. (1996) Relative abundance of plant
diff --git a/man/getWeatherData_folders.Rd b/man/getWeatherData_folders.Rd
index 008209ee..48aa201d 100644
--- a/man/getWeatherData_folders.Rd
+++ b/man/getWeatherData_folders.Rd
@@ -9,7 +9,9 @@ getWeatherData_folders(
weatherDirName = NULL,
filebasename = "weath",
startYear = NULL,
- endYear = NULL
+ endYear = NULL,
+ dailyInputFlags = c(rep(TRUE, 3L), rep(FALSE, 11L)),
+ method = c("R", "C")
)
}
\arguments{
@@ -25,6 +27,12 @@ files.}
\item{startYear}{Numeric. Extracted weather data will start with this year.}
\item{endYear}{Numeric. Extracted weather data will end with this year.}
+
+\item{dailyInputFlags}{A logical vector of length \code{MAX_INPUT_COLUMNS},
+see \code{"weathsetup.in"}.}
+
+\item{method}{A character string. \code{"R"} uses code in \code{R} to read files as-is
+whereas \code{"C"} uses \code{"SOILWAT2"} code to read and process files.}
}
\value{
A list of elements of class \code{\linkS4class{swWeatherData}}.
@@ -34,26 +42,59 @@ A list of elements of class \code{\linkS4class{swWeatherData}}.
data, then you have to impute yourself or use the built-in Markov weather
generator (see examples for \code{\link{sw_exec}}).
}
+\section{Details}{
+
+\code{\link[=dbW_weather_to_SOILWATfiles]{dbW_weather_to_SOILWATfiles()}} offers the inverse operation, i.e.,
+writing weather data to disk files.
+}
+
\examples{
path_demo <- system.file("extdata", "example1", package = "rSOILWAT2")
## ------ Simulation with data prepared beforehand and separate weather data
-## Read inputs from files on disk
+## Read inputs from files on disk (via SOILWAT2)
sw_in3 <- sw_inputDataFromFiles(dir = path_demo, files.in = "files.in")
-## Read forcing weather data from files on disk (there are also functions
-## to set up a SQLite database for the weather data)
-sw_weath3 <- getWeatherData_folders(
- LookupWeatherFolder = file.path(path_demo, "Input"),
- weatherDirName = "data_weather", filebasename = "weath",
- startYear = 1979, endYear = 2010)
+## Read forcing weather data from files on disk (via SOILWAT2)
+sw_weath3c <- getWeatherData_folders(
+ LookupWeatherFolder = file.path(path_demo, "Input"),
+ weatherDirName = "data_weather",
+ filebasename = "weath",
+ startYear = 1979,
+ endYear = 2010,
+ method = "C"
+)
+
+## Read forcing weather data from files on disk (via R)
+sw_weath3r <- getWeatherData_folders(
+ LookupWeatherFolder = file.path(path_demo, "Input"),
+ weatherDirName = "data_weather",
+ filebasename = "weath",
+ startYear = 1979,
+ endYear = 2010,
+ method = "R"
+)
+
+## Weather data (for the non-calculated variables) should be identical
+identical(
+ sw_weath3c[[1L]]@data[, 1:4],
+ rSOILWAT2::get_WeatherHistory(sw_in3)[[1L]]@data[, 1:4]
+)
+identical(
+ sw_weath3r[[1L]]@data[, 1:4],
+ rSOILWAT2::get_WeatherHistory(sw_in3)[[1L]]@data[, 1:4]
+)
## List of the slots of the input objects of class 'swWeatherData'
-utils::str(sw_weath3, max.level=1)
+utils::str(sw_weath3c, max.level = 1)
+utils::str(sw_weath3r, max.level = 1)
## Execute the simulation run
-sw_out3 <- sw_exec(inputData = sw_in3, weatherList = sw_weath3)
+sw_out3c <- sw_exec(inputData = sw_in3, weatherList = sw_weath3c)
+sw_out3r <- sw_exec(inputData = sw_in3, weatherList = sw_weath3r)
+
+all.equal(sw_out3c, sw_out3r)
}
\seealso{
diff --git a/man/get_derived_output.Rd b/man/get_derived_output.Rd
index 10aa8d99..437eec24 100644
--- a/man/get_derived_output.Rd
+++ b/man/get_derived_output.Rd
@@ -7,6 +7,9 @@
\item{x}{An object of class \code{\linkS4class{swOutput}}.}
\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+
+\item{keep_time}{A logical value. Include time information in the returned
+object.}
}
\description{
Calculate derived variables from output
diff --git a/man/get_evaporation.Rd b/man/get_evaporation.Rd
index f1494bd2..17e6237c 100644
--- a/man/get_evaporation.Rd
+++ b/man/get_evaporation.Rd
@@ -4,15 +4,23 @@
\alias{get_evaporation}
\title{Calculate evaporation from output}
\usage{
-get_evaporation(x, timestep = c("Day", "Week", "Month", "Year"))
+get_evaporation(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ keep_time = FALSE
+)
}
\arguments{
\item{x}{An object of class \code{\linkS4class{swOutput}}.}
\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+
+\item{keep_time}{A logical value. Include time information in the returned
+object.}
}
\value{
-A numeric vector of evaporation [mm] for each time step.
+A numeric vector of evaporation [mm] for each time step or
+ a numeric matrix if `keep_time`.
}
\description{
Calculate evaporation from output
diff --git a/man/get_soilmoisture.Rd b/man/get_soilmoisture.Rd
new file mode 100644
index 00000000..0908a117
--- /dev/null
+++ b/man/get_soilmoisture.Rd
@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_OutputDerived_Functions.R
+\name{get_soilmoisture}
+\alias{get_soilmoisture}
+\title{Extract or calculate soil moisture}
+\usage{
+get_soilmoisture(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ type = c("swc", "vwc_bulk", "vwc_matric"),
+ swInput = NULL,
+ widths_cm = NULL,
+ fcoarse = NULL,
+ keep_time = FALSE
+)
+}
+\arguments{
+\item{x}{An object of class \code{\linkS4class{swOutput}}.}
+
+\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+
+\item{type}{A character string selecting type of soil moisture.}
+
+\item{swInput}{An object of class \linkS4class{swInputData}.}
+
+\item{widths_cm}{A numeric vector of soil layer widths (units \verb{[cm]}).}
+
+\item{fcoarse}{A numeric vector of coarse fragments per soil layer
+(units \verb{[volume fraction]}).}
+
+\item{keep_time}{A logical value. Include time information in the returned
+object.}
+}
+\value{
+A data frame with requested soil moisture;
+rows represent time steps and columns represent soil layers.
+}
+\description{
+Extract or calculate soil moisture
+}
+\section{Details}{
+
+Information on soil layer \code{widths} and coarse fragments \code{fcoarse}
+are only used if requested type of soil moisture is
+not available and has to be calculated from a different type.
+\code{widths} and \code{fcoarse} may be provided directly or via \code{swInput}
+from which the information is extracted (see examples).
+}
+
+\examples{
+sw_in <- rSOILWAT2::sw_exampleData
+
+sw_out <- sw_exec(inputData = sw_in)
+res1 <- get_soilmoisture(sw_out, "Month", type = "swc")
+
+deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()[["sw_swcbulk"]]
+sw_out <- sw_exec(inputData = sw_in)
+res2 <- get_soilmoisture(sw_out, "Month", type = "swc", swInput = sw_in)
+all.equal(res1, res2)
+
+res3 <- get_soilmoisture(
+ sw_out,
+ timestep = "Month",
+ type = "swc",
+ widths = diff(c(0., swSoils_Layers(sw_in)[, "depth_cm"])),
+ fcoarse = swSoils_Layers(sw_in)[, "gravel_content"]
+)
+all.equal(res1, res3)
+
+}
diff --git a/man/get_soiltemp.Rd b/man/get_soiltemp.Rd
index 6f831b4f..86b89584 100644
--- a/man/get_soiltemp.Rd
+++ b/man/get_soiltemp.Rd
@@ -10,6 +10,7 @@ get_soiltemp(
levels = c("min", "avg", "max"),
surface = TRUE,
soillayers = NULL,
+ keep_time = FALSE,
verbose = FALSE
)
}
@@ -30,6 +31,9 @@ equivalent to requesting a \code{0} via \code{soillayers}.}
\code{NA} does not return soil temperature;
including a \code{0} is equivalent to setting \code{surface} to \code{TRUE}.}
+\item{keep_time}{A logical value. Include time information in the returned
+object.}
+
\item{verbose}{A logical value. Issue warnings if requested \code{levels} are
not available.}
}
diff --git a/man/get_swMarkov.Rd b/man/get_swMarkov.Rd
new file mode 100644
index 00000000..72681e46
--- /dev/null
+++ b/man/get_swMarkov.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{get_swMarkov}
+\alias{get_swMarkov}
+\title{\code{get_swMarkov}}
+\usage{
+get_swMarkov(object)
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swMarkov}} or
+\code{\linkS4class{swInputData}}.}
+}
+\description{
+\code{get_swMarkov}
+}
+\seealso{
+\code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/get_swWeatherData.Rd b/man/get_swWeatherData.Rd
index d82a5373..8fcbaf98 100644
--- a/man/get_swWeatherData.Rd
+++ b/man/get_swWeatherData.Rd
@@ -9,6 +9,8 @@ get_swWeatherData(object, year)
\arguments{
\item{object}{An object of class \code{\linkS4class{swWeatherData}} or
\code{\linkS4class{swInputData}}.}
+
+\item{year}{An numeric value. The calendar year.}
}
\description{
\code{get_swWeatherData}
diff --git a/man/get_timestamp.Rd b/man/get_timestamp.Rd
index 18dc498a..1a29839d 100644
--- a/man/get_timestamp.Rd
+++ b/man/get_timestamp.Rd
@@ -1,20 +1,13 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/A_swGenericMethods.R, R/K_swContainer.R,
-% R/L_swOutput.R
+% Please edit documentation in R/A_swGenericMethods.R
\name{get_timestamp}
\alias{get_timestamp}
\alias{get_timestamp,ANY-method}
-\alias{get_timestamp,swInputData-method}
-\alias{get_timestamp,swOutput-method}
\title{Retrieve time stamp of an object}
\usage{
get_timestamp(object)
\S4method{get_timestamp}{ANY}(object)
-
-\S4method{get_timestamp}{swInputData}(object)
-
-\S4method{get_timestamp}{swOutput}(object)
}
\arguments{
\item{object}{An object of class \code{\linkS4class{swInputData}} or
diff --git a/man/get_transpiration.Rd b/man/get_transpiration.Rd
index 6ec178d8..e5fbcac2 100644
--- a/man/get_transpiration.Rd
+++ b/man/get_transpiration.Rd
@@ -4,15 +4,23 @@
\alias{get_transpiration}
\title{Calculate transpiration from output}
\usage{
-get_transpiration(x, timestep = c("Day", "Week", "Month", "Year"))
+get_transpiration(
+ x,
+ timestep = c("Day", "Week", "Month", "Year"),
+ keep_time = FALSE
+)
}
\arguments{
\item{x}{An object of class \code{\linkS4class{swOutput}}.}
\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+
+\item{keep_time}{A logical value. Include time information in the returned
+object.}
}
\value{
-A numeric vector of transpiration [mm] for each time step.
+A numeric vector of transpiration [mm] for each time step or
+ a numeric matrix if `keep_time`.
}
\description{
Calculate transpiration from output
@@ -20,5 +28,6 @@ Calculate transpiration from output
\examples{
sw_out <- sw_exec(inputData = rSOILWAT2::sw_exampleData)
get_transpiration(sw_out, "Month")
+get_transpiration(sw_out, "Month", keep_time = TRUE)
}
diff --git a/man/get_version.Rd b/man/get_version.Rd
index 8aed2e04..fca37857 100644
--- a/man/get_version.Rd
+++ b/man/get_version.Rd
@@ -1,31 +1,29 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/A_swGenericMethods.R, R/K_swContainer.R,
-% R/L_swOutput.R
+% Please edit documentation in R/A_swGenericMethods.R
\name{get_version}
\alias{get_version}
\alias{get_version,ANY-method}
-\alias{get_version,swInputData-method}
-\alias{get_version,swOutput-method}
\title{Retrieve version of \pkg{rSOILWAT2} that was used to create object}
\usage{
get_version(object)
\S4method{get_version}{ANY}(object)
-
-\S4method{get_version}{swInputData}(object)
-
-\S4method{get_version}{swOutput}(object)
}
\arguments{
\item{object}{An object of class \code{\linkS4class{swInputData}} or
\code{\linkS4class{swOutput}}.}
}
+\value{
+A character string representing the version number (or \code{NA}).
+}
\description{
Retrieve version of \pkg{rSOILWAT2} that was used to create object
}
\examples{
get_version(rSOILWAT2::sw_exampleData)
get_version(sw_exec(rSOILWAT2::sw_exampleData))
+get_version(as.numeric_version("4.1.3"))
+get_version(packageVersion("rSOILWAT2"))
}
\seealso{
diff --git a/man/get_years_from_weatherDF.Rd b/man/get_years_from_weatherDF.Rd
index df5e7a7e..5c74f6bb 100644
--- a/man/get_years_from_weatherDF.Rd
+++ b/man/get_years_from_weatherDF.Rd
@@ -2,29 +2,38 @@
% Please edit documentation in R/sw_dbW_WeatherDatabase.R
\name{get_years_from_weatherDF}
\alias{get_years_from_weatherDF}
-\title{Assign years to weather data.frame}
+\title{Extract years to weather data.frame}
\usage{
get_years_from_weatherDF(weatherDF, years, weatherDF_dataColumns)
}
\arguments{
-\item{weatherDF}{A data.frame. data.frame containing weather information for
-site.}
+\item{weatherDF}{A \code{data.frame}. Daily weather data where rows represent
+days and columns represent the weather variables
+(see \code{weatherDF_dataColumns}).}
\item{years}{A numeric or integer vector or \code{NULL}. Vector of year data
where length is equal to either the number of years in the weather data.frame
or the number of rows in the data.frame.}
-\item{weatherDF_dataColumns}{A vector of string values. Column names of the
-weather data.frame.}
+\item{weatherDF_dataColumns}{A vector of character strings. The column
+names of \code{weatherDF} in the correct order for \code{SOILWAT2} including
+calendar year \code{year} (optional) and day of year \code{DOY}, see
+\code{\link[=weather_dataColumns]{weather_dataColumns()}}.}
}
\value{
A named list of length 2.
\itemize{
- \item \code{years} a vector of unique year values.
- \item \code{year_ts} a vector of time series values for each row/day of the
+\item \code{years} a vector of unique year values.
+\item \code{year_ts} a vector of time series values for each row/day of the
data.frame.
}
}
\description{
-Assign years to weather data.frame
+Extract years to weather data.frame
}
+\section{Notes}{
+
+The first element of \code{weatherDF_dataColumns} (only the first is used) must
+contain the column name for day of year.
+}
+
diff --git a/man/get_years_from_weatherData.Rd b/man/get_years_from_weatherData.Rd
index d8c35264..8581040b 100644
--- a/man/get_years_from_weatherData.Rd
+++ b/man/get_years_from_weatherData.Rd
@@ -7,7 +7,8 @@
get_years_from_weatherData(wd)
}
\arguments{
-\item{wd}{A list of elements of class \code{\linkS4class{swWeatherData}}}
+\item{wd}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
}
\description{
Extract years from a \var{weatherData} object
diff --git a/man/is_missing_weather.Rd b/man/is_missing_weather.Rd
new file mode 100644
index 00000000..a1d62b6a
--- /dev/null
+++ b/man/is_missing_weather.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{is_missing_weather}
+\alias{is_missing_weather}
+\title{Check which weather values are missing}
+\usage{
+is_missing_weather(x)
+}
+\arguments{
+\item{x}{A two-dimensional numeric object.}
+}
+\value{
+A logical object with same dimensions as \code{x}
+}
+\description{
+Check which weather values are missing
+}
+\examples{
+x <- data.frame(
+ Tmax = c(-1.5, 2, NA, 999),
+ Tmin = c(-5, NaN, 999, -5)
+)
+
+is_missing_weather(x)
+
+}
diff --git a/man/list_matched_swrcs_ptfs.Rd b/man/list_matched_swrcs_ptfs.Rd
new file mode 100644
index 00000000..8cd4ddfe
--- /dev/null
+++ b/man/list_matched_swrcs_ptfs.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{list_matched_swrcs_ptfs}
+\alias{list_matched_swrcs_ptfs}
+\title{Matching pairs of implemented \code{SWRCs} and \code{PTFs}}
+\usage{
+list_matched_swrcs_ptfs(swrc_name = names(swrc_names()))
+}
+\arguments{
+\item{swrc_name}{An character string or vector.
+The selected \code{SWRC} name
+(one of \code{\link[=swrc_names]{swrc_names()}}, with default \code{"Campbell1974"}).}
+}
+\value{
+A \code{data.frame} with two columns \code{SWRC} and \code{PTF} where each
+row contains a matching pair of \code{SWRC} and \code{PTF} that are implemented.
+}
+\description{
+Matching pairs of implemented \code{SWRCs} and \code{PTFs}
+}
+\examples{
+# Data frame of SWRC-PTF combinations
+df_swrc_ptfs <- rSOILWAT2::list_matched_swrcs_ptfs()
+
+# List of SWRC-PTF combinations
+list_swrcs_ptfs <- unname(as.list(as.data.frame(t(df_swrc_ptfs))))
+
+# Available SWRC-PTF combinations
+has_ptf <- check_ptf_availability(df_swrc_ptfs[, "PTF"])
+df_swrc_ptfs[has_ptf, , drop = FALSE]
+list_swrcs_ptfs[has_ptf]
+
+}
diff --git a/man/nrow_output.Rd b/man/nrow_output.Rd
new file mode 100644
index 00000000..74f7436d
--- /dev/null
+++ b/man/nrow_output.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_OutputDerived_Functions.R
+\name{nrow_output}
+\alias{nrow_output}
+\title{Number of time steps in output}
+\usage{
+nrow_output(x, timestep = c("Day", "Week", "Month", "Year"))
+}
+\arguments{
+\item{x}{An object of class \code{\linkS4class{swOutput}}.}
+
+\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+}
+\description{
+Number of time steps in output
+}
+\examples{
+nrow_output(sw_exec(rSOILWAT2::sw_exampleData), "Month")
+
+}
diff --git a/man/pedotransfer.Rd b/man/pedotransfer.Rd
index 0ccc1f28..8f29d379 100644
--- a/man/pedotransfer.Rd
+++ b/man/pedotransfer.Rd
@@ -6,8 +6,8 @@
\alias{pdf_to_swp}
\alias{SWPtoVWC}
\alias{VWCtoSWP}
-\title{Pedotransfer functions to convert between soil moisture (volumetric water
-content, \var{VWC}) and soil water potential (\var{SWP})}
+\title{Deprecated pedotransfer functions to convert between soil moisture
+(volumetric water content, \var{VWC}) and soil water potential (\var{SWP})}
\usage{
pdf_to_vwc(
swp,
@@ -31,9 +31,9 @@ pdf_to_swp(
bar_conversion = 1024
)
-SWPtoVWC(swp, sand, clay)
+SWPtoVWC(swp, sand, clay, ...)
-VWCtoSWP(vwc, sand, clay)
+VWCtoSWP(vwc, sand, clay, ...)
}
\arguments{
\item{swp}{A numeric value, vector, or 2-dimensional object
@@ -46,9 +46,23 @@ fractional value in \code{[0,1]}.}
\item{clay}{A numeric value or vector. Clay content of the soil layer(s) as
fractional value in \code{[0,1]}.}
+\item{thetas}{Soon obsolete ... (see \code{feature_swrc})}
+
+\item{psis}{Soon obsolete ... (see \code{feature_swrc})}
+
+\item{b}{Soon obsolete ... (see \code{feature_swrc})}
+
+\item{MPa_toBar}{Soon obsolete ... (see \code{feature_swrc})}
+
+\item{bar_conversion}{Soon obsolete ... (see \code{feature_swrc})}
+
\item{vwc}{A numeric value, vector, or 2-dimensional object
(matrix or data.frame). The matric soil moisture, i.e., reduced by the
volume of rock and gravel.}
+
+\item{bar_toMPa}{Soon obsolete ... (see \code{feature_swrc})}
+
+\item{...}{Additional arguments.}
}
\value{
Volumetric water content in units of m^3 (of water) / m^3 (of soil)
@@ -112,8 +126,8 @@ Soil water potential in units of \var{MPa} \code{[-Inf, 0]}.
}
}
\description{
-Pedotransfer functions to convert between soil moisture (volumetric water
-content, \var{VWC}) and soil water potential (\var{SWP})
+Deprecated pedotransfer functions to convert between soil moisture
+(volumetric water content, \var{VWC}) and soil water potential (\var{SWP})
Calculate volumetric water content from soil water potential and soil texture
@@ -133,3 +147,7 @@ Cosby, B. J., G. M. Hornberger, R. B. Clapp, and T. R. Ginn.
characteristics to the physical properties of soils. Water Resources Research
20:682-690.
}
+\seealso{
+The use of these functions is deprecated;
+please use \code{ptf_estimate()} and \code{swrc_conversion()} instead.
+}
diff --git a/man/print_mkv_files.Rd b/man/print_mkv_files.Rd
index 705f0730..746ffcbd 100644
--- a/man/print_mkv_files.Rd
+++ b/man/print_mkv_files.Rd
@@ -12,6 +12,12 @@ print_mkv_files(mkv_doy, mkv_woy, path, digits = 5)
\item{mkv_woy}{A data.frame. The same named output element of
\code{\link{dbW_estimate_WGen_coefs}}.}
+
+\item{path}{A character string. The path on disk to the location
+where output files should be created.}
+
+\item{digits}{An integer value. The number of digits with which to write
+the values to disk.}
}
\value{
This function is called for its side effect, i.e., writing values
diff --git a/man/ptf_Rosetta_for_vanGenuchten1980.Rd b/man/ptf_Rosetta_for_vanGenuchten1980.Rd
new file mode 100644
index 00000000..0bb6c927
--- /dev/null
+++ b/man/ptf_Rosetta_for_vanGenuchten1980.Rd
@@ -0,0 +1,82 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptf_Rosetta_for_vanGenuchten1980}
+\alias{ptf_Rosetta_for_vanGenuchten1980}
+\title{Estimate van Genuchten 1980 \code{SWRC} parameters using \code{Rosetta} live \code{API}}
+\usage{
+ptf_Rosetta_for_vanGenuchten1980(
+ sand,
+ clay,
+ bdensity = NULL,
+ version = c("3", "1", "2"),
+ verbose = interactive(),
+ ...
+)
+}
+\arguments{
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{version}{A character string that selects a \code{Rosetta} version.}
+
+\item{verbose}{A logical value. If \code{TRUE}, then display
+\code{SOILWAT2} internal warnings and other messages.}
+
+\item{...}{Additional function arguments passed on or ignored.}
+}
+\value{
+\code{swrcp}, i.e,.
+a numeric matrix where rows represent soil (layers) and
+columns represent a fixed number of \code{SWRC} parameters: \itemize{
+\item \code{swrcp[0]} (\code{theta_r}): residual volumetric water content
+of the matric component (units of \verb{[cm / cm]})
+\item \code{swrcp[1]} (\code{theta_s}): saturated volumetric water content
+of the matric component (units of \verb{[cm / cm]})
+\item \code{swrcp[2]} (\code{alpha}): related to the inverse of
+air entry suction (units of \verb{[cm-1]})
+\item \code{swrcp[3]} (\code{n}): measure of the pore-size distribution \verb{[-]}
+\item \code{swrcp[4]} (\code{K_sat}): saturated hydraulic conductivity \verb{[cm / day]}
+}
+}
+\description{
+Estimate van Genuchten 1980 \code{SWRC} parameters using \code{Rosetta} live \code{API}
+}
+\section{Details}{
+
+\code{\link[=ptf_estimate]{ptf_estimate()}} is the function that should be directly called; this here
+is an internal helper function.
+}
+
+\section{Notes}{
+
+This function calls \code{\link[soilDB:ROSETTA]{soilDB::ROSETTA()}} and
+a live internet connection is required to access \code{Rosetta}.
+}
+
+\references{
+Mualem, Y. 1976. A new model for predicting the hydraulic conductivity of
+unsaturated porous media.
+Water Resources Research, 12:513-522, \doi{10.1029/WR012i003p00513}
+
+van Genuchten, M. T. 1980. A Closed-form Equation for Predicting the
+Hydraulic Conductivity of Unsaturated Soils.
+Soil Science Society of America Journal, 44:892-898,
+\doi{10.2136/sssaj1980.03615995004400050002x}
+
+Zhang, Y., & Schaap, M. G. 2017. Weighted recalibration of the
+Rosetta pedotransfer model with improved estimates of
+hydraulic parameter distributions and summary statistics (Rosetta3).
+Journal of Hydrology, 547:39-53, \doi{10.1016/j.jhydrol.2017.01.004}
+}
+\seealso{
+\code{\link[soilDB:ROSETTA]{soilDB::ROSETTA()}}
+}
diff --git a/man/ptf_estimate.Rd b/man/ptf_estimate.Rd
new file mode 100644
index 00000000..010fd5df
--- /dev/null
+++ b/man/ptf_estimate.Rd
@@ -0,0 +1,128 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptf_estimate}
+\alias{ptf_estimate}
+\title{Estimate \code{SWRC} parameters from soil texture with a pedotransfer function}
+\usage{
+ptf_estimate(
+ sand,
+ clay,
+ fcoarse,
+ bdensity = NULL,
+ swrc_name,
+ ptf_name,
+ fail = FALSE,
+ ...
+)
+}
+\arguments{
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{fcoarse}{A numeric value or vector.
+Coarse fragments, e.g., gravel, (> 2 mm; units of \verb{[m3/m3]})
+relative to the whole soil of each soil layer.
+\code{fcoarse} is required, for instance, to translate between
+values relative to the matric soil component (< 2 mm fraction) and
+relative to the whole soil (matric soil plus coarse fragments).}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{swrc_name}{An character string or vector.
+The selected \code{SWRC} name
+(one of \code{\link[=swrc_names]{swrc_names()}}, with default \code{"Campbell1974"}).}
+
+\item{ptf_name}{An character string or vector.
+The selected \code{PTF} name
+(one of \code{\link[=ptf_names]{ptf_names()}}, with default \code{"Cosby1984AndOthers"}).}
+
+\item{fail}{A logical value.
+Issue a warning (\code{FALSE}, default) or throw an error (\code{TRUE})
+if request fails.}
+
+\item{...}{Additional parameters passed to selected \code{PTF} function.}
+}
+\value{
+\code{swrcp}, i.e,.
+a numeric matrix where rows represent soil (layers) and
+columns represent a fixed number of \code{SWRC} parameters.
+The interpretation is dependent on the selected \code{SWRC}, see
+\code{SOILWAT2} input file \code{swrc_param.in}
+(
+\code{system.file("extdata", "example1", "Input", "swrc_params.in", package = "rSOILWAT2")}
+).
+}
+\description{
+Estimate \code{SWRC} parameters from soil texture with a pedotransfer function
+}
+\section{Notes}{
+
+\code{\link[=swrc_names]{swrc_names()}} lists implemented \code{SWRCs};
+\code{\link[=ptf_names]{ptf_names()}} lists implemented \code{PTFs}; and
+\code{\link[=check_ptf_availability]{check_ptf_availability()}} checks availability of \code{PTFs}.
+
+
+The soil parameters \code{sand}, \code{clay}, \code{fcoarse}, and \code{bdensity} must be of
+the same length, i.e., represent one soil (length 1) or
+multiple soil (layers) (length > 1); however, \code{bdensity} may be \code{NULL}.
+The arguments selecting \code{SWRC} (\code{swrc_name}) and \code{PTF} (\code{ptf_name})
+are recycled for multiple soil layers.
+}
+
+\examples{
+ptf_estimate(sand = c(0.5, 0.3), clay = c(0.2, 0.1), fcoarse = c(0, 0))
+
+soils <- swSoils_Layers(rSOILWAT2::sw_exampleData)
+
+# Use PTF "Cosby1984" to estimate parameters of SWRC "Campbell1974"
+ptf_estimate(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"],
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984"
+)
+
+# Use PTF "Rosetta3" to estimate parameters of SWRC "vanGenuchten1980"
+if (check_ptf_availability("Rosetta3")) {
+ ptf_estimate(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"],
+ bdensity = soils[, "bulkDensity_g/cm^3"],
+ swrc_name = "vanGenuchten1980",
+ ptf_name = "Rosetta3"
+ )
+}
+
+# Use PTF "neuroFX2021" to estimate parameters of SWRC `FXW`
+\dontrun{
+# Set neuroFX2021 file path, see details in `ptf_neuroFX2021_for_FXW()`
+options(RSW2_FILENEUROFX2021 = "path/to/sscbd.RData")
+}
+
+if (check_ptf_availability("neuroFX2021")) {
+ ptf_estimate(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"],
+ bdensity = soils[, "bulkDensity_g/cm^3"],
+ swrc_name = "FXW",
+ ptf_name = "neuroFX2021"
+ )
+}
+
+}
+\references{
+Cosby, B. J., G. M. Hornberger, R. B. Clapp, & T. R. Ginn. 1984.
+A statistical exploration of the relationships of soil moisture
+characteristics to the physical properties of soils.
+Water Resources Research, 20:682-690, \doi{10.1029/WR020i006p00682}
+}
diff --git a/man/ptf_names.Rd b/man/ptf_names.Rd
new file mode 100644
index 00000000..631f90f3
--- /dev/null
+++ b/man/ptf_names.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptf_names}
+\alias{ptf_names}
+\title{List Pedotransfer Functions \code{PTFs}}
+\usage{
+ptf_names()
+}
+\value{
+An named integer vector with names of implemented \code{PTFs}
+}
+\description{
+List Pedotransfer Functions \code{PTFs}
+}
+\details{
+Notes:
+The integer values may change with new versions of \code{SOILWAT2.}
+}
+\seealso{
+\code{\link{SWRCs}}, \code{\link[=swrc_names]{swrc_names()}}, \code{\link[=check_ptf_availability]{check_ptf_availability()}}
+}
diff --git a/man/ptf_neuroFX2021_for_FXW.Rd b/man/ptf_neuroFX2021_for_FXW.Rd
new file mode 100644
index 00000000..1f6d0997
--- /dev/null
+++ b/man/ptf_neuroFX2021_for_FXW.Rd
@@ -0,0 +1,87 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptf_neuroFX2021_for_FXW}
+\alias{ptf_neuroFX2021_for_FXW}
+\title{Estimate \code{FXW} \code{SWRC} parameters using \code{neuroFX2021}}
+\usage{
+ptf_neuroFX2021_for_FXW(
+ sand,
+ clay,
+ bdensity = NULL,
+ file_neuroFX2021 = getOption("RSW2_FILENEUROFX2021", NULL),
+ ...
+)
+}
+\arguments{
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{file_neuroFX2021}{A character string that contains the file name with
+full path of the \code{neuroFX2021} R object provided by Rudiyanto et al. 2021;
+The path to the appropriate file can be set per R session
+via option \code{"RSW2_FILENEUROFX2021"}, see additional details.}
+
+\item{...}{Additional function arguments passed on or ignored.}
+}
+\value{
+\code{swrcp}, i.e,.
+a numeric matrix where rows represent soil (layers) and
+columns represent a fixed number of \code{SWRC} parameters: \itemize{
+\item \code{swrcp[0]} (\code{theta_s}): saturated volumetric water content
+of the matric component (units of \verb{[cm / cm]})
+\item \code{swrcp[1]} (\code{alpha}): shape parameter (units of \verb{[cm-1]})
+\item \code{swrcp[2]} (\code{n}): shape parameter \verb{[-]}
+\item \code{swrcp[3]} (\code{m}): shape parameter \verb{[-]}
+\item \code{swrcp[4]} (\code{K_sat}): saturated hydraulic conductivity \verb{[cm / day]}
+\item \code{swrcp[5]} (\code{L}): tortuosity/connectivity parameter \verb{[-]}
+}
+}
+\description{
+Estimate \code{FXW} \code{SWRC} parameters using \code{neuroFX2021}
+}
+\section{Details}{
+
+\code{\link[=ptf_estimate]{ptf_estimate()}} is the function that should be directly called; this here
+is an internal helper function.
+
+
+This function requires that users download
+the fitted \code{neuroFX2021} neural networks published by Rudiyanto et al. 2021
+in Supplementary Material 1 (resulting in a local file named \code{xxx_mmc1.zip}).
+This needs to be unzipped and the resulting \code{tar} file unpacked;
+this produces a folder \verb{R code for neuroFX2021}.
+This folder contains two R data files : \code{ssc.RData} and \code{sscbd.RData}.
+The argument \code{file_neuroFX2021} is the file name (with path) to \code{sscbd.RData}
+if soil density data are available and to \code{ssc.RData} otherwise
+(see Rudiyanto et al. 2021).
+The path to the appropriate file can be set per R session
+via option \code{"RSW2_FILENEUROFX2021"}
+(and avoid passing it directly as argument to the function);
+this can be useful, for example, if \code{ptf_estimate()} is used for \code{FXW}.
+}
+
+\references{
+Rudiyanto, Minasny, B., Chaney, N. W., Maggi, F., Goh Eng Giap, S.,
+Shah, R. M., Fiantis, D., & Setiawan, B. I. 2021.
+Pedotransfer functions for estimating soil hydraulic properties from
+saturation to dryness.
+Geoderma, 403:115194, \doi{10.1016/j.geoderma.2021.115194}
+
+Fredlund, D. G., & Xing, A. 1994.
+Equations for the soil-water characteristic curve.
+Canadian Geotechnical Journal, 31: 512–532, \doi{10.1139/t94-061}
+
+Wang, Y., Jin, M., & Deng, Z. 2018.
+Alternative model for predicting soil hydraulic conductivity over
+the complete moisture range.
+Water Resources Research, 54:6860–6876, \doi{10.1029/2018WR023037}
+}
diff --git a/man/ptfs_implemented_by_SW2.Rd b/man/ptfs_implemented_by_SW2.Rd
new file mode 100644
index 00000000..2a8ad210
--- /dev/null
+++ b/man/ptfs_implemented_by_SW2.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptfs_implemented_by_SW2}
+\alias{ptfs_implemented_by_SW2}
+\title{List \code{PTFs} implemented by \code{SOILWAT2}}
+\usage{
+ptfs_implemented_by_SW2(names_only = FALSE)
+}
+\arguments{
+\item{names_only}{A logical value, see \code{return} value.}
+}
+\value{
+An named integer vector (if not \code{names_only})
+with or a character vector (if \code{names_only}) names of implemented \code{PTFs}.
+}
+\description{
+List \code{PTFs} implemented by \code{SOILWAT2}
+}
diff --git a/man/ptfs_implemented_by_rSW2.Rd b/man/ptfs_implemented_by_rSW2.Rd
new file mode 100644
index 00000000..e8d4eb4c
--- /dev/null
+++ b/man/ptfs_implemented_by_rSW2.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{ptfs_implemented_by_rSW2}
+\alias{ptfs_implemented_by_rSW2}
+\title{List \code{PTFs} implemented by \code{rSOILWAT2}}
+\usage{
+ptfs_implemented_by_rSW2()
+}
+\description{
+List \code{PTFs} implemented by \code{rSOILWAT2}
+}
diff --git a/man/rSOILWAT2-defunct.Rd b/man/rSOILWAT2-defunct.Rd
index 352a46ab..988cbe3c 100644
--- a/man/rSOILWAT2-defunct.Rd
+++ b/man/rSOILWAT2-defunct.Rd
@@ -34,6 +34,9 @@ simTiming_ForEachUsedTimeUnit(...)
update_requested_years(...)
}
+\arguments{
+\item{...}{Function arguments. Unused since functions are defunct.}
+}
\description{
Executing a defunct function will fail and tell you which function
replaces them.
diff --git a/man/rSW2_SWRC_PTF_estimate_parameters.Rd b/man/rSW2_SWRC_PTF_estimate_parameters.Rd
new file mode 100644
index 00000000..8f4cd7cd
--- /dev/null
+++ b/man/rSW2_SWRC_PTF_estimate_parameters.Rd
@@ -0,0 +1,76 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{rSW2_SWRC_PTF_estimate_parameters}
+\alias{rSW2_SWRC_PTF_estimate_parameters}
+\title{Estimate parameters of selected soil water retention curve (\code{SWRC})
+using selected pedotransfer function (\code{PTF}) that are implemented in \code{R}}
+\usage{
+rSW2_SWRC_PTF_estimate_parameters(
+ ptf_name,
+ sand,
+ clay,
+ fcoarse,
+ bdensity = NULL,
+ fail = TRUE,
+ ...
+)
+}
+\arguments{
+\item{ptf_name}{An character string or vector.
+The selected \code{PTF} name
+(one of \code{\link[=ptf_names]{ptf_names()}}, with default \code{"Cosby1984AndOthers"}).}
+
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{fcoarse}{A numeric value or vector.
+Coarse fragments, e.g., gravel, (> 2 mm; units of \verb{[m3/m3]})
+relative to the whole soil of each soil layer.
+\code{fcoarse} is required, for instance, to translate between
+values relative to the matric soil component (< 2 mm fraction) and
+relative to the whole soil (matric soil plus coarse fragments).}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{fail}{A logical value. If requested \code{PTF} fails,
+then issue a warning (\code{FALSE}) or throw an error (\code{TRUE}, default).}
+
+\item{...}{Additional parameters passed to selected \code{PTF} function.}
+}
+\value{
+\code{swrcp}, i.e,.
+a numeric matrix where rows represent soil (layers) and
+columns represent a fixed number of \code{SWRC} parameters.
+The interpretation is dependent on the selected \code{SWRC}.
+However, return value is \code{NULL}
+only if \code{fail} is \code{FALSE} and requested \code{PTF} is not implemented in \code{R}.
+}
+\description{
+Estimate parameters of selected soil water retention curve (\code{SWRC})
+using selected pedotransfer function (\code{PTF}) that are implemented in \code{R}
+}
+\section{Details}{
+
+\code{\link[=ptf_estimate]{ptf_estimate()}} is the function that should be directly called; this here
+is an internal helper function.
+}
+
+\section{Notes}{
+
+See \code{SWRC_PTF_estimate_parameters()} in \code{SOILWAT2} for \code{PTFs}
+implemented in C.
+}
+
+\references{
+Cosby, B. J., G. M. Hornberger, R. B. Clapp, & T. R. Ginn. 1984.
+A statistical exploration of the relationships of soil moisture
+characteristics to the physical properties of soils.
+Water Resources Research, 20:682-690, \doi{10.1029/WR020i006p00682}
+}
diff --git a/man/set_Markov.Rd b/man/set_Markov.Rd
index 527ff060..dd2c20ae 100644
--- a/man/set_Markov.Rd
+++ b/man/set_Markov.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_Markov}
\alias{set_Markov}
-\title{\code{set_Markov}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_Markov<-}} doesn't work.}
+\title{\code{set_Markov}}
\usage{
set_Markov(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swMarkov}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_Markov}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_Markov<-}} doesn't work.
}
diff --git a/man/set_WeatherHistory.Rd b/man/set_WeatherHistory.Rd
index cb492ded..c0385a8a 100644
--- a/man/set_WeatherHistory.Rd
+++ b/man/set_WeatherHistory.Rd
@@ -2,14 +2,15 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_WeatherHistory}
\alias{set_WeatherHistory}
-\title{\code{set_WeatherHistory}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_WeatherHistory<-}} doesn't work.}
+\title{\code{set_WeatherHistory}}
\usage{
set_WeatherHistory(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_WeatherHistory}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_WeatherHistory<-}} doesn't work.
}
diff --git a/man/set_swCarbon.Rd b/man/set_swCarbon.Rd
index 97a5186d..f178dd76 100644
--- a/man/set_swCarbon.Rd
+++ b/man/set_swCarbon.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swCarbon}
\alias{set_swCarbon}
-\title{\code{set_swCarbon}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swCarbon<-}} doesn't work.}
+\title{\code{set_swCarbon}}
\usage{
set_swCarbon(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swCarbon}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swCarbon}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swCarbon<-}} doesn't work.
}
diff --git a/man/set_swCloud.Rd b/man/set_swCloud.Rd
index b7864fcd..a806f236 100644
--- a/man/set_swCloud.Rd
+++ b/man/set_swCloud.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swCloud}
\alias{set_swCloud}
-\title{\code{set_swCloud}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swCloud<-}} doesn't work.}
+\title{\code{set_swCloud}}
\usage{
set_swCloud(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swCloud}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swCloud}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swCloud<-}} doesn't work.
}
diff --git a/man/set_swFiles.Rd b/man/set_swFiles.Rd
index b71bb890..b4cd6c6e 100644
--- a/man/set_swFiles.Rd
+++ b/man/set_swFiles.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swFiles}
\alias{set_swFiles}
-\title{\code{set_swFiles}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swFiles<-}} doesn't work.}
+\title{\code{set_swFiles}}
\usage{
set_swFiles(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swFiles}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swFiles}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swFiles<-}} doesn't work.
}
diff --git a/man/set_swMarkov-set.Rd b/man/set_swMarkov-set.Rd
new file mode 100644
index 00000000..23a5eb57
--- /dev/null
+++ b/man/set_swMarkov-set.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{set_swMarkov<-}
+\alias{set_swMarkov<-}
+\title{\code{set_swMarkov<-}}
+\usage{
+set_swMarkov(object) <- value
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swMarkov}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
+\description{
+\code{set_swMarkov<-}
+}
+\seealso{
+\code{\linkS4class{swMarkov}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/set_swMarkov.Rd b/man/set_swMarkov.Rd
new file mode 100644
index 00000000..831b5cb0
--- /dev/null
+++ b/man/set_swMarkov.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{set_swMarkov}
+\alias{set_swMarkov}
+\title{\code{set_swMarkov}}
+\usage{
+set_swMarkov(object, value)
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swMarkov}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
+\description{
+\code{set_swMarkov}
+}
diff --git a/man/set_swOUT.Rd b/man/set_swOUT.Rd
index 8675c5fd..d0f60fce 100644
--- a/man/set_swOUT.Rd
+++ b/man/set_swOUT.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swOUT}
\alias{set_swOUT}
-\title{\code{set_swOUT}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swOUT<-}} doesn't work.}
+\title{\code{set_swOUT}}
\usage{
set_swOUT(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swOUT}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swOUT}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swOUT<-}} doesn't work.
}
diff --git a/man/set_swProd.Rd b/man/set_swProd.Rd
index 2590bbcd..f43b0f5e 100644
--- a/man/set_swProd.Rd
+++ b/man/set_swProd.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swProd}
\alias{set_swProd}
-\title{\code{set_swProd}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swProd<-}} doesn't work.}
+\title{\code{set_swProd}}
\usage{
set_swProd(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swProd}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swProd}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swProd<-}} doesn't work.
}
diff --git a/man/set_swSWC.Rd b/man/set_swSWC.Rd
index ec764bdc..295fc353 100644
--- a/man/set_swSWC.Rd
+++ b/man/set_swSWC.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swSWC}
\alias{set_swSWC}
-\title{\code{set_swSWC}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSWC<-}} doesn't work.}
+\title{\code{set_swSWC}}
\usage{
set_swSWC(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swSWC}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swSWC}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSWC<-}} doesn't work.
}
diff --git a/man/set_swSite.Rd b/man/set_swSite.Rd
index 597ed038..0928bf7a 100644
--- a/man/set_swSite.Rd
+++ b/man/set_swSite.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swSite}
\alias{set_swSite}
-\title{\code{set_swSite}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSite<-}} doesn't work.}
+\title{\code{set_swSite}}
\usage{
set_swSite(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swSite}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swSite}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSite<-}} doesn't work.
}
diff --git a/man/set_swSoils.Rd b/man/set_swSoils.Rd
index d5c9b94f..cd970150 100644
--- a/man/set_swSoils.Rd
+++ b/man/set_swSoils.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swSoils}
\alias{set_swSoils}
-\title{\code{set_swSoils}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSoils<-}} doesn't work.}
+\title{\code{set_swSoils}}
\usage{
set_swSoils(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swSoils}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swSoils}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swSoils<-}} doesn't work.
}
diff --git a/man/set_swWeather.Rd b/man/set_swWeather.Rd
index ea364468..3c8178d8 100644
--- a/man/set_swWeather.Rd
+++ b/man/set_swWeather.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swWeather}
\alias{set_swWeather}
-\title{\code{set_swWeather}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swWeather<-}} doesn't work.}
+\title{\code{set_swWeather}}
\usage{
set_swWeather(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swWeather}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swWeather}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swWeather<-}} doesn't work.
}
diff --git a/man/set_swWeatherData.Rd b/man/set_swWeatherData.Rd
index 69b93cb0..493a6efd 100644
--- a/man/set_swWeatherData.Rd
+++ b/man/set_swWeatherData.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swWeatherData}
\alias{set_swWeatherData}
-\title{\code{set_swWeatherData}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swWeatherData<-}} doesn't work.}
+\title{\code{set_swWeatherData}}
\usage{
set_swWeatherData(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swWeatherData}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swWeatherData}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swWeatherData<-}} doesn't work.
}
diff --git a/man/set_swYears.Rd b/man/set_swYears.Rd
index 19b80218..d4c953dc 100644
--- a/man/set_swYears.Rd
+++ b/man/set_swYears.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{set_swYears}
\alias{set_swYears}
-\title{\code{set_swYears}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swYears<-}} doesn't work.}
+\title{\code{set_swYears}}
\usage{
set_swYears(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swYears}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{set_swYears}
-Need to define and export this generic method -- otherwise,
-\code{\link{set_swYears<-}} doesn't work.
}
diff --git a/man/sw2_trco_table.Rd b/man/sw2_trco_table.Rd
index b1ceb81d..48598f27 100644
--- a/man/sw2_trco_table.Rd
+++ b/man/sw2_trco_table.Rd
@@ -18,7 +18,7 @@ A named list with two elements:
represent amount of roots per centimeter soil depth.
}
\item{data}{
- A code{data.frame} with the rooting profile values.
+ A \code{data.frame} with the rooting profile values.
}
}
}
diff --git a/man/swCarbon-class.Rd b/man/swCarbon-class.Rd
index b7f4e0d1..b2c5f5a0 100644
--- a/man/swCarbon-class.Rd
+++ b/man/swCarbon-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swCarbon-class}
\alias{swCarbon-class}
-\alias{initialize,swCarbon-method}
+\alias{swCarbon}
\alias{get_swCarbon,swCarbon-method}
\alias{swCarbon_Use_Bio,swCarbon-method}
\alias{swCarbon_Use_WUE,swCarbon-method}
@@ -18,7 +18,7 @@
\alias{swCarbon_CO2ppm<-,swCarbon-method}
\title{Class \code{"swCarbon"}}
\usage{
-\S4method{initialize}{swCarbon}(.Object, ...)
+swCarbon(...)
\S4method{get_swCarbon}{swCarbon}(object)
@@ -45,9 +45,14 @@
\S4method{swCarbon_CO2ppm}{swCarbon}(object) <- value
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swCarbon}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swCarbon}}.}
@@ -81,6 +86,7 @@ column and CO2 ppm concentrations in the second column.}
\examples{
showClass("swCarbon")
x <- new("swCarbon")
+x <- swCarbon()
}
\seealso{
diff --git a/man/swCloud-class.Rd b/man/swCloud-class.Rd
index a39bebdf..7f49a177 100644
--- a/man/swCloud-class.Rd
+++ b/man/swCloud-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swCloud-class}
\alias{swCloud-class}
-\alias{initialize,swCloud-method}
+\alias{swCloud}
\alias{get_swCloud,swCloud-method}
\alias{swCloud_SkyCover,swCloud-method}
\alias{swCloud_WindSpeed,swCloud-method}
@@ -19,7 +19,7 @@
\alias{swReadLines,swCloud,character-method}
\title{Class \code{"swCloud"}}
\usage{
-\S4method{initialize}{swCloud}(.Object, ...)
+swCloud(...)
\S4method{get_swCloud}{swCloud}(object)
@@ -48,9 +48,14 @@
\S4method{swReadLines}{swCloud,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swCloud}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swCloud}}.}
@@ -65,6 +70,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swCloud")
x <- new("swCloud")
+x <- swCloud()
}
\seealso{
diff --git a/man/swEstab-class.Rd b/man/swEstab-class.Rd
index 0f434c60..4f978e95 100644
--- a/man/swEstab-class.Rd
+++ b/man/swEstab-class.Rd
@@ -3,13 +3,13 @@
\docType{class}
\name{swEstab-class}
\alias{swEstab-class}
-\alias{initialize,swEstab-method}
+\alias{swEstab}
\alias{swEstab_useEstab,swEstab-method}
\alias{swEstab_useEstab<-,swEstab-method}
\alias{swReadLines,swEstab,character-method}
\title{Class \code{"swEstab"}}
\usage{
-\S4method{initialize}{swEstab}(.Object, ...)
+swEstab(...)
\S4method{swEstab_useEstab}{swEstab}(object)
@@ -18,9 +18,14 @@
\S4method{swReadLines}{swEstab,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swEstab}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swEstab}}.}
@@ -35,6 +40,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swEstab")
x <- new("swEstab")
+x <- swEstab()
}
\seealso{
diff --git a/man/swEstabSpecies-class.Rd b/man/swEstabSpecies-class.Rd
index 1ec9c40b..5e790582 100644
--- a/man/swEstabSpecies-class.Rd
+++ b/man/swEstabSpecies-class.Rd
@@ -3,18 +3,23 @@
\docType{class}
\name{swEstabSpecies-class}
\alias{swEstabSpecies-class}
-\alias{initialize,swEstabSpecies-method}
+\alias{swEstabSpecies}
\alias{swReadLines,swEstabSpecies,character-method}
\title{Class \code{"swEstabSpecies"}}
\usage{
-\S4method{initialize}{swEstabSpecies}(.Object, ...)
+swEstabSpecies(...)
\S4method{swReadLines}{swEstabSpecies,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swEstabSpecies}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swEstabSpecies}}.}
@@ -27,6 +32,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swEstabSpecies")
x <- new("swEstabSpecies")
+x <- swEstabSpecies()
}
\seealso{
diff --git a/man/swFiles-class.Rd b/man/swFiles-class.Rd
index 3c17a23b..70b0d63f 100644
--- a/man/swFiles-class.Rd
+++ b/man/swFiles-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swFiles-class}
\alias{swFiles-class}
-\alias{initialize,swFiles-method}
+\alias{swFiles}
\alias{swFiles_ProjDir,swFiles-method}
\alias{swFiles_WeatherPrefix,swFiles-method}
\alias{swFiles_OutputPrefix,swFiles-method}
@@ -12,6 +12,7 @@
\alias{swFiles_LogFile,swFiles-method}
\alias{swFiles_SiteParams,swFiles-method}
\alias{swFiles_Soils,swFiles-method}
+\alias{swFiles_SWRCp,swFiles-method}
\alias{swFiles_WeatherSetup,swFiles-method}
\alias{swFiles_MarkovProbs,swFiles-method}
\alias{swFiles_MarkovCov,swFiles-method}
@@ -29,6 +30,7 @@
\alias{swFiles_LogFile<-,swFiles-method}
\alias{swFiles_SiteParams<-,swFiles-method}
\alias{swFiles_Soils<-,swFiles-method}
+\alias{swFiles_SWRCp<-,swFiles-method}
\alias{swFiles_WeatherSetup<-,swFiles-method}
\alias{swFiles_MarkovProbs<-,swFiles-method}
\alias{swFiles_MarkovCov<-,swFiles-method}
@@ -41,7 +43,7 @@
\alias{swReadLines,swFiles,character-method}
\title{Class \code{"swFiles"}}
\usage{
-\S4method{initialize}{swFiles}(.Object, ...)
+swFiles(...)
\S4method{swFiles_ProjDir}{swFiles}(object)
@@ -59,6 +61,8 @@
\S4method{swFiles_Soils}{swFiles}(object)
+\S4method{swFiles_SWRCp}{swFiles}(object)
+
\S4method{swFiles_WeatherSetup}{swFiles}(object)
\S4method{swFiles_MarkovProbs}{swFiles}(object)
@@ -93,6 +97,8 @@
\S4method{swFiles_Soils}{swFiles}(object) <- value
+\S4method{swFiles_SWRCp}{swFiles}(object) <- value
+
\S4method{swFiles_WeatherSetup}{swFiles}(object) <- value
\S4method{swFiles_MarkovProbs}{swFiles}(object) <- value
@@ -114,9 +120,14 @@
\S4method{swReadLines}{swFiles,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swFiles}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swFiles}}.}
@@ -131,6 +142,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swFiles")
x <- new("swFiles")
+x <- swFiles()
}
\seealso{
diff --git a/man/swFiles_SWRCp-set.Rd b/man/swFiles_SWRCp-set.Rd
new file mode 100644
index 00000000..d0b0ff45
--- /dev/null
+++ b/man/swFiles_SWRCp-set.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{swFiles_SWRCp<-}
+\alias{swFiles_SWRCp<-}
+\title{\code{swFiles_SWRCp<-}}
+\usage{
+swFiles_SWRCp(object) <- value
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swFiles}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
+\description{
+\code{swFiles_SWRCp<-}
+}
+\seealso{
+\code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/swFiles_SWRCp.Rd b/man/swFiles_SWRCp.Rd
new file mode 100644
index 00000000..ccecd3f2
--- /dev/null
+++ b/man/swFiles_SWRCp.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{swFiles_SWRCp}
+\alias{swFiles_SWRCp}
+\title{\code{swFiles_SWRCp}}
+\usage{
+swFiles_SWRCp(object)
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swFiles}} or
+\code{\linkS4class{swInputData}}.}
+}
+\description{
+\code{swFiles_SWRCp}
+}
+\seealso{
+\code{\linkS4class{swFiles}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/swInputData-class.Rd b/man/swInputData-class.Rd
index 7bde7e2b..35e3a2ea 100644
--- a/man/swInputData-class.Rd
+++ b/man/swInputData-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swInputData-class}
\alias{swInputData-class}
-\alias{initialize,swInputData-method}
+\alias{swInputData}
\alias{get_swFiles,swInputData-method}
\alias{swFiles_ProjDir,swInputData-method}
\alias{swFiles_filesIn,swInputData-method}
@@ -11,6 +11,7 @@
\alias{swFiles_LogFile,swInputData-method}
\alias{swFiles_SiteParams,swInputData-method}
\alias{swFiles_Soils,swInputData-method}
+\alias{swFiles_SWRCp,swInputData-method}
\alias{swFiles_WeatherSetup,swInputData-method}
\alias{swFiles_MarkovProbs,swInputData-method}
\alias{swFiles_MarkovCov,swInputData-method}
@@ -29,6 +30,7 @@
\alias{swFiles_LogFile<-,swInputData-method}
\alias{swFiles_SiteParams<-,swInputData-method}
\alias{swFiles_Soils<-,swInputData-method}
+\alias{swFiles_SWRCp<-,swInputData-method}
\alias{swFiles_WeatherSetup<-,swInputData-method}
\alias{swFiles_MarkovProbs<-,swInputData-method}
\alias{swFiles_MarkovCov<-,swInputData-method}
@@ -83,9 +85,11 @@
\alias{swCloud_SnowDensity<-,swInputData-method}
\alias{swCloud_RainEvents<-,swInputData-method}
\alias{get_Markov,swInputData-method}
+\alias{get_swMarkov,swInputData-method}
\alias{swMarkov_Prob,swInputData-method}
\alias{swMarkov_Conv,swInputData-method}
\alias{set_Markov<-,swInputData-method}
+\alias{set_swMarkov<-,swInputData-method}
\alias{swMarkov_Prob<-,swInputData-method}
\alias{swMarkov_Conv<-,swInputData-method}
\alias{get_WeatherHistory,swInputData-method}
@@ -130,6 +134,7 @@
\alias{swProd_MonProd_shrub<-,swInputData-method}
\alias{swProd_MonProd_tree<-,swInputData-method}
\alias{swProd_MonProd_forb<-,swInputData-method}
+\alias{get_swEstab,swInputData-method}
\alias{get_swSite,swInputData-method}
\alias{swSite_SWClimits,swInputData-method}
\alias{swSite_ModelFlags,swInputData-method}
@@ -141,6 +146,7 @@
\alias{swSite_IntrinsicSiteParams,swInputData-method}
\alias{swSite_SoilTemperatureFlag,swInputData-method}
\alias{swSite_SoilTemperatureConsts,swInputData-method}
+\alias{swSite_SoilDensityInputType,swInputData-method}
\alias{swSite_TranspirationRegions,swInputData-method}
\alias{set_swSite<-,swInputData-method}
\alias{swSite_SWClimits<-,swInputData-method}
@@ -153,11 +159,11 @@
\alias{swSite_IntrinsicSiteParams<-,swInputData-method}
\alias{swSite_SoilTemperatureFlag<-,swInputData-method}
\alias{swSite_SoilTemperatureConsts<-,swInputData-method}
+\alias{swSite_SoilDensityInputType<-,swInputData-method}
\alias{swSite_TranspirationRegions<-,swInputData-method}
\alias{get_swSoils,swInputData-method}
-\alias{swSoils_Layers,swInputData-method}
\alias{set_swSoils<-,swInputData,swSoils-method}
-\alias{swSoils_Layers<-,swInputData,matrix-method}
+\alias{set_swSoils<-,swInputData,list-method}
\alias{get_swSWC,swInputData-method}
\alias{swSWC_use,swInputData-method}
\alias{swSWC_prefix,swInputData-method}
@@ -197,7 +203,7 @@
\alias{swReadLines,swInputData,character-method}
\title{Class \code{"swInputData"}}
\usage{
-\S4method{initialize}{swInputData}(.Object)
+swInputData(...)
\S4method{get_swFiles}{swInputData}(object)
@@ -213,6 +219,8 @@
\S4method{swFiles_Soils}{swInputData}(object)
+\S4method{swFiles_SWRCp}{swInputData}(object)
+
\S4method{swFiles_WeatherSetup}{swInputData}(object)
\S4method{swFiles_MarkovProbs}{swInputData}(object)
@@ -249,6 +257,8 @@
\S4method{swFiles_Soils}{swInputData}(object) <- value
+\S4method{swFiles_SWRCp}{swInputData}(object) <- value
+
\S4method{swFiles_WeatherSetup}{swInputData}(object) <- value
\S4method{swFiles_MarkovProbs}{swInputData}(object) <- value
@@ -361,12 +371,16 @@
\S4method{get_Markov}{swInputData}(object)
+\S4method{get_swMarkov}{swInputData}(object)
+
\S4method{swMarkov_Prob}{swInputData}(object)
\S4method{swMarkov_Conv}{swInputData}(object)
\S4method{set_Markov}{swInputData}(object) <- value
+\S4method{set_swMarkov}{swInputData}(object) <- value
+
\S4method{swMarkov_Prob}{swInputData}(object) <- value
\S4method{swMarkov_Conv}{swInputData}(object) <- value
@@ -455,6 +469,8 @@
\S4method{swProd_MonProd_forb}{swInputData}(object) <- value
+\S4method{get_swEstab}{swInputData}(object)
+
\S4method{get_swSite}{swInputData}(object)
\S4method{swSite_SWClimits}{swInputData}(object)
@@ -477,6 +493,8 @@
\S4method{swSite_SoilTemperatureConsts}{swInputData}(object)
+\S4method{swSite_SoilDensityInputType}{swInputData}(object)
+
\S4method{swSite_TranspirationRegions}{swInputData}(object)
\S4method{set_swSite}{swInputData}(object) <- value
@@ -501,15 +519,15 @@
\S4method{swSite_SoilTemperatureConsts}{swInputData}(object) <- value
+\S4method{swSite_SoilDensityInputType}{swInputData}(object) <- value
+
\S4method{swSite_TranspirationRegions}{swInputData}(object) <- value
\S4method{get_swSoils}{swInputData}(object)
-\S4method{swSoils_Layers}{swInputData}(object)
-
\S4method{set_swSoils}{swInputData,swSoils}(object) <- value
-\S4method{swSoils_Layers}{swInputData,matrix}(object) <- value
+\S4method{set_swSoils}{swInputData,list}(object) <- value
\S4method{get_swSWC}{swInputData}(object)
@@ -586,7 +604,14 @@
\S4method{swReadLines}{swInputData,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swInputData}}.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swInputData}}.}
@@ -598,8 +623,6 @@
\item{vegtype}{The name or index of the vegetation type.}
\item{file}{A character string. The file name from which to read.}
-
-\item{...}{Further arguments to methods.}
}
\description{
This class is a container class to the input file \var{S4} objects. The
@@ -609,7 +632,7 @@ classes in the container's slots.
\details{
\code{\linkS4class{swInputData}} consists of slots for each file that is
read in. These slots can be accessed via the following functions: \itemize{
- \item \code{\link{get_Markov}}
+ \item \code{\link{get_swMarkov}}
\item \code{\link{get_swCloud}}
\item \code{\link{get_swFiles}}
\item \code{\link{get_swOUT}}
@@ -632,7 +655,8 @@ Generic methods to get/set individual elements follow a format:
}
\examples{
showClass("swInputData")
-x <- new("swInputData")
+x <- new("swInputData") # prototype
+x <- swInputData() # constructor helper
}
\seealso{
diff --git a/man/swLog-class.Rd b/man/swLog-class.Rd
index c2904840..a54b7af5 100644
--- a/man/swLog-class.Rd
+++ b/man/swLog-class.Rd
@@ -3,15 +3,20 @@
\docType{class}
\name{swLog-class}
\alias{swLog-class}
-\alias{initialize,swLog-method}
+\alias{swLog}
\title{Class \code{"swLog"}}
\usage{
-\S4method{initialize}{swLog}(.Object, ...)
+swLog(...)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swLog}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
}
\description{
The methods listed below work on this class and the proper slot of the class
@@ -20,6 +25,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swLog")
x <- new("swLog")
+x <- swLog()
}
\seealso{
diff --git a/man/swMarkov-class.Rd b/man/swMarkov-class.Rd
index 05c9d161..1490b679 100644
--- a/man/swMarkov-class.Rd
+++ b/man/swMarkov-class.Rd
@@ -3,26 +3,32 @@
\docType{class}
\name{swMarkov-class}
\alias{swMarkov-class}
-\alias{initialize,swMarkov-method}
+\alias{swMarkov}
\alias{get_Markov,swMarkov-method}
+\alias{get_swMarkov,swMarkov-method}
\alias{swMarkov_Prob,swMarkov-method}
\alias{swMarkov_Conv,swMarkov-method}
\alias{set_Markov<-,swMarkov-method}
+\alias{set_swMarkov<-,swMarkov-method}
\alias{swMarkov_Prob<-,swMarkov-method}
\alias{swMarkov_Conv<-,swMarkov-method}
\alias{swReadLines,swMarkov,character-method}
\title{Class \code{"swMarkov"}}
\usage{
-\S4method{initialize}{swMarkov}(.Object, ...)
+swMarkov(...)
\S4method{get_Markov}{swMarkov}(object)
+\S4method{get_swMarkov}{swMarkov}(object)
+
\S4method{swMarkov_Prob}{swMarkov}(object)
\S4method{swMarkov_Conv}{swMarkov}(object)
\S4method{set_Markov}{swMarkov}(object) <- value
+\S4method{set_swMarkov}{swMarkov}(object) <- value
+
\S4method{swMarkov_Prob}{swMarkov}(object) <- value
\S4method{swMarkov_Conv}{swMarkov}(object) <- value
@@ -30,9 +36,14 @@
\S4method{swReadLines}{swMarkov,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swMarkov}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swMarkov}}.}
@@ -47,6 +58,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swMarkov")
x <- new("swMarkov")
+x <- swMarkov()
}
\seealso{
diff --git a/man/swMonthlyScalingParams-class.Rd b/man/swMonthlyScalingParams-class.Rd
index 33e59b0d..21c97055 100644
--- a/man/swMonthlyScalingParams-class.Rd
+++ b/man/swMonthlyScalingParams-class.Rd
@@ -3,16 +3,20 @@
\docType{class}
\name{swMonthlyScalingParams-class}
\alias{swMonthlyScalingParams-class}
-\alias{initialize,swMonthlyScalingParams-method}
+\alias{swMonthlyScalingParams}
\title{Class \code{"swMonthlyScalingParams"}}
\usage{
-\S4method{initialize}{swMonthlyScalingParams}(.Object, ...)
+swMonthlyScalingParams(...)
}
\arguments{
-\item{.Object}{An object of class
-\code{\linkS4class{swMonthlyScalingParams}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
}
\description{
The methods listed below work on this class and the proper slot of the class
@@ -21,6 +25,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swMonthlyScalingParams")
x <- new("swMonthlyScalingParams")
+x <- swMonthlyScalingParams()
}
\seealso{
diff --git a/man/swOUT-class.Rd b/man/swOUT-class.Rd
index 1477f8f9..a6cec949 100644
--- a/man/swOUT-class.Rd
+++ b/man/swOUT-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swOUT-class}
\alias{swOUT-class}
-\alias{initialize,swOUT-method}
+\alias{swOUT}
\alias{get_swOUT,swOUT-method}
\alias{swOUT_TimeStep,swOUT-method}
\alias{swOUT_OutputSeparator,swOUT-method}
@@ -16,7 +16,7 @@
\alias{swReadLines,swOUT,character-method}
\title{Class \code{swOUT}}
\usage{
-\S4method{initialize}{swOUT}(.Object, ...)
+swOUT(...)
\S4method{get_swOUT}{swOUT}(object)
@@ -39,9 +39,14 @@
\S4method{swReadLines}{swOUT,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swOUT}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swOUT}}.}
@@ -84,16 +89,21 @@ for each possible output time period. See details.}
\examples{
showClass("swOUT")
x <- new("swOUT")
+x <- swOUT()
-x <- new("swOUT")
+x <- swOUT()
activate_swOUT_OutKey(x) <- c("VWCMATRIC", "HYDRED")
-x <- new("swOUT")
+x <- swOUT()
deactivate_swOUT_OutKey(x) <- c("VWCMATRIC", "HYDRED")
-x <- new("swOUT")
+x <- swOUT()
swOUT_TimeStepsForEveryKey(x) <- c(2, 3)
-identical(as.vector(unique(swOUT_TimeStep(x))), as.integer(c(2, 3)))
+identical(
+ unique(sort(as.vector(swOUT_TimeStep(x)))),
+ as.integer(c(2, 3, 999)) # 999 represents 'eSW_NoTime'
+)
+
}
\seealso{
\code{\linkS4class{swInputData}}
diff --git a/man/swOUT_TimeStepsForEveryKey.Rd b/man/swOUT_TimeStepsForEveryKey.Rd
index 5181baf6..6a1455eb 100644
--- a/man/swOUT_TimeStepsForEveryKey.Rd
+++ b/man/swOUT_TimeStepsForEveryKey.Rd
@@ -2,14 +2,16 @@
% Please edit documentation in R/A_swGenericMethods.R
\name{swOUT_TimeStepsForEveryKey}
\alias{swOUT_TimeStepsForEveryKey}
-\title{\code{swOUT_TimeStepsForEveryKey}
-Need to define and export this generic method -- otherwise,
-\code{\link{swOUT_TimeStepsForEveryKey<-}} doesn't work.}
+\title{\code{swOUT_TimeStepsForEveryKey}}
\usage{
swOUT_TimeStepsForEveryKey(object, value)
}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swOUT}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
\description{
\code{swOUT_TimeStepsForEveryKey}
-Need to define and export this generic method -- otherwise,
-\code{\link{swOUT_TimeStepsForEveryKey<-}} doesn't work.
}
diff --git a/man/swOUT_key-class.Rd b/man/swOUT_key-class.Rd
index 4ca86279..f7c20fa9 100644
--- a/man/swOUT_key-class.Rd
+++ b/man/swOUT_key-class.Rd
@@ -3,15 +3,20 @@
\docType{class}
\name{swOUT_key-class}
\alias{swOUT_key-class}
-\alias{initialize,swOUT_key-method}
+\alias{swOUT_key}
\title{Class \code{"swOUT_key"}}
\usage{
-\S4method{initialize}{swOUT_key}(.Object, ...)
+swOUT_key(...)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swOUT_key}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
}
\description{
The methods listed below work on this class and the proper slot of the class
@@ -20,5 +25,6 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swOUT_key")
x <- new("swOUT_key")
+x <- swOUT_key()
}
diff --git a/man/swOutput-class.Rd b/man/swOutput-class.Rd
index 310160e9..b4cf0876 100644
--- a/man/swOutput-class.Rd
+++ b/man/swOutput-class.Rd
@@ -3,14 +3,12 @@
\docType{class}
\name{swOutput-class}
\alias{swOutput-class}
-\alias{initialize,swOutput-method}
+\alias{swOutput}
\alias{$,swOutput-method}
\alias{swOutput_getKEY,swOutput-method}
\alias{swOutput_setKEY<-,swOutput,ANY,swOutput_KEY-method}
\title{Class \code{"swOutput"}}
\usage{
-\S4method{initialize}{swOutput}(.Object)
-
\S4method{$}{swOutput}(x, name)
\S4method{swOutput_getKEY}{swOutput}(object, index)
diff --git a/man/swOutput_KEY-class.Rd b/man/swOutput_KEY-class.Rd
index 517790d5..59728249 100644
--- a/man/swOutput_KEY-class.Rd
+++ b/man/swOutput_KEY-class.Rd
@@ -3,6 +3,7 @@
\docType{class}
\name{swOutput_KEY-class}
\alias{swOutput_KEY-class}
+\alias{swOutput_KEY}
\alias{swOutput_KEY_Period,swOutput_KEY-method}
\alias{swOutput_KEY_TimeStep,swOutput_KEY-method}
\alias{swOutput_KEY_Columns,swOutput_KEY-method}
diff --git a/man/swOutput_KEY_Period-set.Rd b/man/swOutput_KEY_Period-set.Rd
index 8d5677d0..07906562 100644
--- a/man/swOutput_KEY_Period-set.Rd
+++ b/man/swOutput_KEY_Period-set.Rd
@@ -10,6 +10,8 @@ swOutput_KEY_Period(object, index) <- value
\item{object}{An object of class \code{\linkS4class{swOutput}} or
\code{\linkS4class{swInputData}}.}
+\item{index}{An integer value. The "key" (slot) position.}
+
\item{value}{A value to assign to a specific slot of the \code{object}.}
}
\description{
diff --git a/man/swOutput_KEY_Period.Rd b/man/swOutput_KEY_Period.Rd
index 5d4f609e..5b53df6d 100644
--- a/man/swOutput_KEY_Period.Rd
+++ b/man/swOutput_KEY_Period.Rd
@@ -9,6 +9,8 @@ swOutput_KEY_Period(object, index)
\arguments{
\item{object}{An object of class \code{\linkS4class{swOutput}} or
\code{\linkS4class{swInputData}}.}
+
+\item{index}{An integer value. The "key" (slot) position.}
}
\description{
\code{swOutput_KEY_Period}
diff --git a/man/swOutput_getKEY.Rd b/man/swOutput_getKEY.Rd
index 290ce0e4..783d5465 100644
--- a/man/swOutput_getKEY.Rd
+++ b/man/swOutput_getKEY.Rd
@@ -9,6 +9,8 @@ swOutput_getKEY(object, index)
\arguments{
\item{object}{An object of class \code{\linkS4class{swOutput}} or
\code{\linkS4class{swInputData}}.}
+
+\item{index}{An integer value. The "key" (slot) position.}
}
\description{
\code{swOutput_getKEY}
diff --git a/man/swOutput_setKEY-set.Rd b/man/swOutput_setKEY-set.Rd
index e34692d2..a8fc037f 100644
--- a/man/swOutput_setKEY-set.Rd
+++ b/man/swOutput_setKEY-set.Rd
@@ -10,6 +10,8 @@ swOutput_setKEY(object, index) <- value
\item{object}{An object of class \code{\linkS4class{swOutput}} or
\code{\linkS4class{swInputData}}.}
+\item{index}{An integer value. The "key" (slot) position.}
+
\item{value}{A value to assign to a specific slot of the \code{object}.}
}
\description{
diff --git a/man/swProd-class.Rd b/man/swProd-class.Rd
index 1c7c6a6d..19ceedd3 100644
--- a/man/swProd-class.Rd
+++ b/man/swProd-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swProd-class}
\alias{swProd-class}
-\alias{initialize,swProd-method}
+\alias{swProd}
\alias{get_swProd,swProd-method}
\alias{swProd_Composition,swProd-method}
\alias{swProd_Albedo,swProd-method}
@@ -45,7 +45,7 @@
\alias{swReadLines,swProd,character-method}
\title{Class \code{"swProd"}}
\usage{
-\S4method{initialize}{swProd}(.Object, ...)
+swProd(...)
\S4method{get_swProd}{swProd}(object)
@@ -126,9 +126,14 @@
\S4method{swReadLines}{swProd,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swProd}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swProd}}.}
@@ -145,6 +150,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swProd")
x <- new("swProd")
+x <- swProd()
}
\seealso{
diff --git a/man/swReadLines.Rd b/man/swReadLines.Rd
index cde193ad..a8f78523 100644
--- a/man/swReadLines.Rd
+++ b/man/swReadLines.Rd
@@ -8,6 +8,8 @@ swReadLines(object, file)
}
\arguments{
\item{object}{An object of a class such \code{\linkS4class{swInputData}}.}
+
+\item{file}{A character string. The file path.}
}
\description{
\code{swReadLines}
diff --git a/man/swSWC-class.Rd b/man/swSWC-class.Rd
index cb3fbc67..4fc9369a 100644
--- a/man/swSWC-class.Rd
+++ b/man/swSWC-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swSWC-class}
\alias{swSWC-class}
-\alias{initialize,swSWC-method}
+\alias{swSWC}
\alias{swSWC_use,swSWC-method}
\alias{swSWC_prefix,swSWC-method}
\alias{swSWC_FirstYear,swSWC-method}
@@ -19,7 +19,7 @@
\alias{swReadLines,swSWC,character-method}
\title{Class \code{"swSWC"}}
\usage{
-\S4method{initialize}{swSWC}(.Object, ...)
+swSWC(...)
\S4method{swSWC_use}{swSWC}(object)
@@ -48,9 +48,14 @@
\S4method{swReadLines}{swSWC,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swSWC}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swSWC}}.}
@@ -68,6 +73,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swSWC")
x <- new("swSWC")
+x <- swSWC()
}
\seealso{
diff --git a/man/swSWC_HistoricData.Rd b/man/swSWC_HistoricData.Rd
index 516ba4fe..1438b62a 100644
--- a/man/swSWC_HistoricData.Rd
+++ b/man/swSWC_HistoricData.Rd
@@ -9,6 +9,8 @@ swSWC_HistoricData(object, year)
\arguments{
\item{object}{An object of class \code{\linkS4class{swSWC}} or
\code{\linkS4class{swInputData}}.}
+
+\item{year}{An numeric value. The calendar year.}
}
\description{
\code{swSWC_HistoricData}
diff --git a/man/swSWC_hist-class.Rd b/man/swSWC_hist-class.Rd
index aa42a342..73c7bc63 100644
--- a/man/swSWC_hist-class.Rd
+++ b/man/swSWC_hist-class.Rd
@@ -3,25 +3,23 @@
\docType{class}
\name{swSWC_hist-class}
\alias{swSWC_hist-class}
-\alias{initialize,swSWC_hist-method}
+\alias{swSWC_hist}
\alias{swReadLines,swSWC_hist,character-method}
\title{Class \code{"swSWC_hist"}}
\usage{
-\S4method{initialize}{swSWC_hist}(.Object, ..., year = 0L, data = NULL)
+swSWC_hist(...)
\S4method{swReadLines}{swSWC_hist,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swSWC_hist}}.}
-
-\item{...}{Further arguments to methods.}
-
-\item{year}{An integer value. The calendar year of the \var{SWC}
-\code{data} object.}
-
-\item{data}{A 365 x 4 or 366 x 4 matrix representing daily \var{SWC}
-data for one calendar \code{year} with columns \var{doy}, \var{lyr},
-\var{swc}, \var{st_err}.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swSWC_hist}}.}
@@ -31,3 +29,14 @@ data for one calendar \code{year} with columns \var{doy}, \var{lyr},
The methods listed below work on this class and the proper slot of the class
\code{\linkS4class{swInputData}}.
}
+\section{Slots}{
+
+\describe{
+\item{\code{year}}{An integer value. The calendar year of the \var{SWC}
+\code{data} object.}
+
+\item{\code{data}}{A 365 x 4 or 366 x 4 matrix representing daily \var{SWC}
+data for one calendar \code{year} with columns \var{doy}, \var{lyr},
+\var{swc}, \var{st_err}.}
+}}
+
diff --git a/man/swSite-class.Rd b/man/swSite-class.Rd
index 58f2fb39..ca06ee66 100644
--- a/man/swSite-class.Rd
+++ b/man/swSite-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swSite-class}
\alias{swSite-class}
-\alias{initialize,swSite-method}
+\alias{swSite}
\alias{get_swSite,swSite-method}
\alias{swSite_SWClimits,swSite-method}
\alias{swSite_ModelFlags,swSite-method}
@@ -16,6 +16,7 @@
\alias{swSite_SoilTemperatureFlag,swSite-method}
\alias{swSite_SoilTemperatureConsts,swSite-method}
\alias{swSite_TranspirationRegions,swSite-method}
+\alias{swSite_SoilDensityInputType,swSite-method}
\alias{set_swSite<-,swSite-method}
\alias{swSite_SWClimits<-,swSite-method}
\alias{swSite_ModelFlags<-,swSite-method}
@@ -27,11 +28,12 @@
\alias{swSite_IntrinsicSiteParams<-,swSite-method}
\alias{swSite_SoilTemperatureFlag<-,swSite-method}
\alias{swSite_SoilTemperatureConsts<-,swSite-method}
+\alias{swSite_SoilDensityInputType<-,swSite-method}
\alias{swSite_TranspirationRegions<-,swSite-method}
\alias{swReadLines,swSite,character-method}
\title{Class \code{"swSite"}}
\usage{
-\S4method{initialize}{swSite}(.Object, ...)
+swSite(...)
\S4method{get_swSite}{swSite}(object)
@@ -57,6 +59,8 @@
\S4method{swSite_TranspirationRegions}{swSite}(object)
+\S4method{swSite_SoilDensityInputType}{swSite}(object)
+
\S4method{set_swSite}{swSite}(object) <- value
\S4method{swSite_SWClimits}{swSite}(object) <- value
@@ -79,14 +83,21 @@
\S4method{swSite_SoilTemperatureConsts}{swSite}(object) <- value
+\S4method{swSite_SoilDensityInputType}{swSite}(object) <- value
+
\S4method{swSite_TranspirationRegions}{swSite}(object) <- value
\S4method{swReadLines}{swSite,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swSite}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swSite}}.}
@@ -101,6 +112,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swSite")
x <- new("swSite")
+x <- swSite()
}
\seealso{
diff --git a/man/swSite_SWRCflags.Rd b/man/swSite_SWRCflags.Rd
new file mode 100644
index 00000000..8c142d3c
--- /dev/null
+++ b/man/swSite_SWRCflags.Rd
@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R, R/F_swSite.R,
+% R/K_swContainer.R
+\name{swSite_SWRCflags}
+\alias{swSite_SWRCflags}
+\alias{swSite_SWRCflags<-}
+\alias{swSite_SWRCflags,swSite-method}
+\alias{swSite_SWRCflags<-,swSite-method}
+\alias{swSite_SWRCflags,swInputData-method}
+\alias{swSite_SWRCflags<-,swInputData-method}
+\title{Names of \code{SWRC} and \code{PTF}}
+\usage{
+swSite_SWRCflags(object)
+
+swSite_SWRCflags(object) <- value
+
+\S4method{swSite_SWRCflags}{swSite}(object)
+
+\S4method{swSite_SWRCflags}{swSite}(object) <- value
+
+\S4method{swSite_SWRCflags}{swInputData}(object)
+
+\S4method{swSite_SWRCflags}{swInputData}(object) <- value
+}
+\arguments{
+\item{object}{An object of class \linkS4class{swSite} or \linkS4class{swInputData}.}
+
+\item{value}{A character vector with two elements for
+\code{"swrc_name"} and \code{"ptf_name"}.}
+}
+\value{
+A character vector with two elements \code{"swrc_name"} and \code{"ptf_name"}.
+}
+\description{
+Names of \code{SWRC} and \code{PTF}
+}
+\section{Details}{
+
+The replacement method \code{\link[=swSite_SWRCflags]{swSite_SWRCflags()}} for class \linkS4class{swInputData}
+resets \code{has_swrcp} to \code{FALSE} if \code{"swrc_name"} or \code{"ptf_name"} are updated.
+This is to avoid inconsistency between
+\code{SWRCp}, \code{has_swrcp}, and \code{swrc_flags}.
+
+
+The correct sequence for setting values is
+\enumerate{
+\item \code{\link[=swSoils_Layers]{swSoils_Layers()}},
+\item \code{\link[=swSite_SWRCflags]{swSite_SWRCflags()}}, and
+\item \code{\link[=swSoils_SWRCp]{swSoils_SWRCp()}} and \code{\link[=swSite_hasSWRCp]{swSite_hasSWRCp()}}
+}
+}
+
diff --git a/man/swSite_SoilDensityInputType-set.Rd b/man/swSite_SoilDensityInputType-set.Rd
new file mode 100644
index 00000000..08bdfe5d
--- /dev/null
+++ b/man/swSite_SoilDensityInputType-set.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{swSite_SoilDensityInputType<-}
+\alias{swSite_SoilDensityInputType<-}
+\title{\code{swSite_SoilDensityInputType<-}}
+\usage{
+swSite_SoilDensityInputType(object) <- value
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swSite}} or
+\code{\linkS4class{swInputData}}.}
+
+\item{value}{A value to assign to a specific slot of the \code{object}.}
+}
+\description{
+\code{swSite_SoilDensityInputType<-}
+}
+\seealso{
+\code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/swSite_SoilDensityInputType.Rd b/man/swSite_SoilDensityInputType.Rd
new file mode 100644
index 00000000..e5f565c7
--- /dev/null
+++ b/man/swSite_SoilDensityInputType.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R
+\name{swSite_SoilDensityInputType}
+\alias{swSite_SoilDensityInputType}
+\title{\code{swSite_SoilTemperatureFlag}}
+\usage{
+swSite_SoilDensityInputType(object)
+}
+\arguments{
+\item{object}{An object of class \code{\linkS4class{swSite}} or
+\code{\linkS4class{swInputData}}.}
+}
+\description{
+\code{swSite_SoilTemperatureFlag}
+}
+\seealso{
+\code{\linkS4class{swSite}} and \code{\linkS4class{swInputData}}
+}
diff --git a/man/swSite_hasSWRCp.Rd b/man/swSite_hasSWRCp.Rd
new file mode 100644
index 00000000..9d1796b1
--- /dev/null
+++ b/man/swSite_hasSWRCp.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R, R/F_swSite.R,
+% R/K_swContainer.R
+\name{swSite_hasSWRCp}
+\alias{swSite_hasSWRCp}
+\alias{swSite_hasSWRCp<-}
+\alias{swSite_hasSWRCp,swSite-method}
+\alias{swSite_hasSWRCp<-,swSite-method}
+\alias{swSite_hasSWRCp,swInputData-method}
+\alias{swSite_hasSWRCp<-,swInputData-method}
+\title{Are \code{SWRC} parameters provided in \code{SWRCp}?}
+\usage{
+swSite_hasSWRCp(object)
+
+swSite_hasSWRCp(object) <- value
+
+\S4method{swSite_hasSWRCp}{swSite}(object)
+
+\S4method{swSite_hasSWRCp}{swSite}(object) <- value
+
+\S4method{swSite_hasSWRCp}{swInputData}(object)
+
+\S4method{swSite_hasSWRCp}{swInputData}(object) <- value
+}
+\arguments{
+\item{object}{An object of class \linkS4class{swSite} or \linkS4class{swInputData}.}
+
+\item{value}{A logical value.}
+}
+\value{
+A logical value.
+\code{TRUE} if \code{SWRC} parameters are provided in \code{SWRCp};
+\code{FALSE} if \code{SWRCp} should be estimated during a simulation run
+via specified pedotransfer function
+(see \code{"ptf_name"} of \code{\link[=swSite_SWRCflags]{swSite_SWRCflags()}}).
+}
+\description{
+Set to \code{TRUE} once \code{SWRCp} are set.
+}
diff --git a/man/swSoils-class.Rd b/man/swSoils-class.Rd
index 2992b795..e0f101a2 100644
--- a/man/swSoils-class.Rd
+++ b/man/swSoils-class.Rd
@@ -3,30 +3,32 @@
\docType{class}
\name{swSoils-class}
\alias{swSoils-class}
-\alias{initialize,swSoils-method}
+\alias{swSoils}
\alias{get_swSoils,swSoils-method}
-\alias{swSoils_Layers,swSoils-method}
\alias{set_swSoils<-,swSoils,swSoils-method}
-\alias{swSoils_Layers<-,swSoils,matrix-method}
+\alias{set_swSoils<-,swSoils,list-method}
\alias{swReadLines,swSoils,character-method}
\title{Class \code{"swSoils"}}
\usage{
-\S4method{initialize}{swSoils}(.Object, ...)
+swSoils(...)
\S4method{get_swSoils}{swSoils}(object)
-\S4method{swSoils_Layers}{swSoils}(object)
-
\S4method{set_swSoils}{swSoils,swSoils}(object) <- value
-\S4method{swSoils_Layers}{swSoils,matrix}(object) <- value
+\S4method{set_swSoils}{swSoils,list}(object) <- value
\S4method{swReadLines}{swSoils,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swSoils}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swSoils}}.}
@@ -41,6 +43,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swSoils")
x <- new("swSoils")
+x <- swSoils()
}
\seealso{
diff --git a/man/swSoils_Layers-set.Rd b/man/swSoils_Layers-set.Rd
deleted file mode 100644
index ba3a5233..00000000
--- a/man/swSoils_Layers-set.Rd
+++ /dev/null
@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/A_swGenericMethods.R
-\name{swSoils_Layers<-}
-\alias{swSoils_Layers<-}
-\title{\code{swSoils_Layers<-}}
-\usage{
-swSoils_Layers(object) <- value
-}
-\arguments{
-\item{object}{An object of class \code{\linkS4class{swSoils}} or
-\code{\linkS4class{swInputData}}.}
-
-\item{value}{A value to assign to a specific slot of the \code{object}.}
-}
-\description{
-\code{swSoils_Layers<-}
-}
-\seealso{
-\code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
-}
diff --git a/man/swSoils_Layers.Rd b/man/swSoils_Layers.Rd
index 29986a14..e5e4ea48 100644
--- a/man/swSoils_Layers.Rd
+++ b/man/swSoils_Layers.Rd
@@ -1,18 +1,50 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/A_swGenericMethods.R
+% Please edit documentation in R/A_swGenericMethods.R, R/F_swSoils.R,
+% R/K_swContainer.R
\name{swSoils_Layers}
\alias{swSoils_Layers}
-\title{\code{swSoils_Layers}}
+\alias{swSoils_Layers<-}
+\alias{swSoils_Layers,swSoils-method}
+\alias{swSoils_Layers<-,swSoils-method}
+\alias{swSoils_Layers,swInputData-method}
+\alias{swSoils_Layers<-,swInputData-method}
+\title{Interact with the soil layer data frame}
\usage{
swSoils_Layers(object)
+
+swSoils_Layers(object) <- value
+
+\S4method{swSoils_Layers}{swSoils}(object)
+
+\S4method{swSoils_Layers}{swSoils}(object) <- value
+
+\S4method{swSoils_Layers}{swInputData}(object)
+
+\S4method{swSoils_Layers}{swInputData}(object) <- value
}
\arguments{
-\item{object}{An object of class \code{\linkS4class{swSoils}} or
-\code{\linkS4class{swInputData}}.}
+\item{object}{An object of class \code{\link{swSoils}} or \linkS4class{swInputData}.}
+
+\item{value}{An object that can be converted to a data matrix and represents
+required soil layer information.}
}
\description{
-\code{swSoils_Layers}
+Interact with the soil layer data frame
}
-\seealso{
-\code{\linkS4class{swSoils}} and \code{\linkS4class{swInputData}}
+\section{Details}{
+
+The replacement method \verb{swSoils_Layers<-} for class \linkS4class{swInputData}
+resizes \code{SWRCp} to match number of new soil layers
+(and reset \code{SWRCp} values to \code{NA}) if \code{"has_swrcp"} is \code{FALSE}.
+This is to avoid inconsistency between
+soil properties and \code{SWRCp}.
+
+
+The correct sequence for setting values is
+\enumerate{
+\item \code{\link[=swSoils_Layers]{swSoils_Layers()}},
+\item \code{\link[=swSite_SWRCflags]{swSite_SWRCflags()}}, and
+\item \code{\link[=swSoils_SWRCp]{swSoils_SWRCp()}} and \code{\link[=swSite_hasSWRCp]{swSite_hasSWRCp()}}
}
+}
+
diff --git a/man/swSoils_SWRCp.Rd b/man/swSoils_SWRCp.Rd
new file mode 100644
index 00000000..ec13f1b6
--- /dev/null
+++ b/man/swSoils_SWRCp.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R, R/F_swSoils.R,
+% R/K_swContainer.R
+\name{swSoils_SWRCp}
+\alias{swSoils_SWRCp}
+\alias{swSoils_SWRCp<-}
+\alias{swSoils_SWRCp,swSoils-method}
+\alias{swSoils_SWRCp<-,swSoils-method}
+\alias{swSoils_SWRCp,swInputData-method}
+\alias{swSoils_SWRCp<-,swInputData-method}
+\title{\code{SWRC} parameters}
+\usage{
+swSoils_SWRCp(object)
+
+swSoils_SWRCp(object) <- value
+
+\S4method{swSoils_SWRCp}{swSoils}(object)
+
+\S4method{swSoils_SWRCp}{swSoils}(object) <- value
+
+\S4method{swSoils_SWRCp}{swInputData}(object)
+
+\S4method{swSoils_SWRCp}{swInputData}(object) <- value
+}
+\arguments{
+\item{object}{An object of class \code{\link{swSoils}} or \linkS4class{swInputData}.}
+
+\item{value}{An object that can be converted to a data matrix and represents
+required `SWRC` parameters.}
+}
+\value{
+A data matrix.
+}
+\description{
+\code{SWRC} parameters
+}
+\section{Details}{
+
+The correct sequence for setting values is
+\enumerate{
+\item \code{\link[=swSoils_Layers]{swSoils_Layers()}},
+\item \code{\link[=swSite_SWRCflags]{swSite_SWRCflags()}}, and
+\item \code{\link[=swSoils_SWRCp]{swSoils_SWRCp()}} and \code{\link[=swSite_hasSWRCp]{swSite_hasSWRCp()}}
+}
+}
+
diff --git a/man/swWeather-class.Rd b/man/swWeather-class.Rd
index 55c58d40..4d06865b 100644
--- a/man/swWeather-class.Rd
+++ b/man/swWeather-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swWeather-class}
\alias{swWeather-class}
-\alias{initialize,swWeather-method}
+\alias{swWeather}
\alias{swWeather_DaysRunningAverage,swWeather-method}
\alias{swWeather_FirstYearHistorical,swWeather-method}
\alias{swWeather_pct_SnowDrift,swWeather-method}
@@ -23,7 +23,7 @@
\alias{swReadLines,swWeather,character-method}
\title{Class \code{"swWeather"}}
\usage{
-\S4method{initialize}{swWeather}(.Object, ...)
+swWeather(...)
\S4method{swWeather_DaysRunningAverage}{swWeather}(object)
@@ -60,9 +60,14 @@
\S4method{swReadLines}{swWeather,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swWeather}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swWeather}}.}
@@ -77,6 +82,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swWeather")
x <- new("swWeather")
+x <- swWeather()
}
\seealso{
diff --git a/man/swWeatherData-class.Rd b/man/swWeatherData-class.Rd
index 5e2f2c34..881ed3a1 100644
--- a/man/swWeatherData-class.Rd
+++ b/man/swWeatherData-class.Rd
@@ -3,25 +3,30 @@
\docType{class}
\name{swWeatherData-class}
\alias{swWeatherData-class}
-\alias{initialize,swWeatherData-method}
+\alias{swWeatherData}
+\alias{weatherHistory}
\alias{swReadLines,swWeatherData,character-method}
\title{Class \code{"swWeatherData"}}
\usage{
-\S4method{initialize}{swWeatherData}(.Object, ..., year = 0L, data = NULL)
+swWeatherData(...)
+
+weatherHistory(weatherList = NULL)
\S4method{swReadLines}{swWeatherData,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swWeatherData}}.}
-
-\item{...}{Further arguments to methods.}
-
-\item{year}{An integer value. The calendar year of the weather \code{data}
-object.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
-\item{data}{A 365 x 4 or 366 x 4 matrix representing daily weather data for
-one calendar \code{year} with columns \var{DOY}, \var{Tmax_C},
-\var{Tmin_C}, and \var{PPT_cm}.}
+\item{weatherList}{A list or \code{NULL}. Each element is an object of class
+\code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}}
+containing daily weather data of a specific year.}
\item{object}{An object of class \code{\linkS4class{swWeatherData}}.}
@@ -31,9 +36,29 @@ one calendar \code{year} with columns \var{DOY}, \var{Tmax_C},
The methods listed below work on this class and the proper slot of the class
\code{\linkS4class{swInputData}}.
}
+\section{Slots}{
+
+\describe{
+\item{\code{year}}{An integer value. The calendar year of the weather \code{data}
+object.}
+
+\item{\code{data}}{A 365 x 15 or 366 x 15 matrix representing daily weather data for
+one calendar \code{year} with columns
+\var{DOY},
+\var{Tmax_C}, \var{Tmin_C}, \var{PPT_cm},
+\var{cloudCov_pct},
+\var{windSpeed_mPERs},
+\var{windSpeed_east_mPERs}, \var{windSpeed_north_mPERs},
+\var{rHavg_pct}, \var{rHmax_pct}, \var{rHmin_pct},
+\var{specHavg_pct}, \var{Tdewpoint_C},
+\var{actVP_kPa}, and
+\var{shortWR}.}
+}}
+
\examples{
showClass("swWeatherData")
x <- new("swWeatherData")
+x <- swWeatherData()
}
\seealso{
diff --git a/man/swYears-class.Rd b/man/swYears-class.Rd
index f900d70f..d307f81c 100644
--- a/man/swYears-class.Rd
+++ b/man/swYears-class.Rd
@@ -3,7 +3,7 @@
\docType{class}
\name{swYears-class}
\alias{swYears-class}
-\alias{initialize,swYears-method}
+\alias{swYears}
\alias{swYears_StartYear,swYears-method}
\alias{swYears_EndYear,swYears-method}
\alias{swYears_FDOFY,swYears-method}
@@ -17,7 +17,7 @@
\alias{swReadLines,swYears,character-method}
\title{Class \code{"swYears"}}
\usage{
-\S4method{initialize}{swYears}(.Object, ...)
+swYears(...)
\S4method{swYears_StartYear}{swYears}(object)
@@ -42,9 +42,14 @@
\S4method{swReadLines}{swYears,character}(object, file)
}
\arguments{
-\item{.Object}{An object of class \code{\linkS4class{swYears}}.}
-
-\item{...}{Further arguments to methods.}
+\item{...}{Arguments to the helper constructor function.
+Dots can either contain objects to copy into slots of that class
+(must be named identical to the corresponding slot) or
+be one object of that class (in which case it will be copied and
+any missing slots will take their default values).
+If dots are missing, then corresponding values of
+\code{rSOILWAT2::sw_exampleData}
+(i.e., the \pkg{SOILWAT2} "testing" defaults) are copied.}
\item{object}{An object of class \code{\linkS4class{swYears}}.}
@@ -59,6 +64,7 @@ The methods listed below work on this class and the proper slot of the class
\examples{
showClass("swYears")
x <- new("swYears")
+x <- swYears()
}
\seealso{
diff --git a/man/sw_Cheatgrass_ClimVar.Rd b/man/sw_Cheatgrass_ClimVar.Rd
index 27cf5f59..bd583c41 100644
--- a/man/sw_Cheatgrass_ClimVar.Rd
+++ b/man/sw_Cheatgrass_ClimVar.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_Miscellaneous_Functions.R
+% Please edit documentation in R/rSOILWAT2_deprecated.R
\name{sw_Cheatgrass_ClimVar}
\alias{sw_Cheatgrass_ClimVar}
\title{Calculate climate variables required to estimate percent cheatgrass cover
diff --git a/man/sw_dailyC4_TempVar.Rd b/man/sw_dailyC4_TempVar.Rd
index ef998b55..43cb87c3 100644
--- a/man/sw_dailyC4_TempVar.Rd
+++ b/man/sw_dailyC4_TempVar.Rd
@@ -1,11 +1,24 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sw_Miscellaneous_Functions.R
+% Please edit documentation in R/rSOILWAT2_deprecated.R
\name{sw_dailyC4_TempVar}
\alias{sw_dailyC4_TempVar}
\title{Calculate variables required to estimate percent C4 species in North America}
\usage{
sw_dailyC4_TempVar(dailyTempMin, dailyTempMean, simTime2)
}
+\arguments{
+\item{dailyTempMin}{A numeric vector. Time series of daily minimum air
+temperature \verb{[C]}.}
+
+\item{dailyTempMean}{A numeric vector. Time series of daily mean air
+temperature \verb{[C]}.}
+
+\item{simTime2}{A list with two named elements. The elements are numeric
+vectors \var{month_ForEachUsedDay_NSadj} and
+\var{year_ForEachUsedDay_NSadj}; they are calculated internally
+if \code{NULL}; alternatively, they can be generated by a call to the
+function \code{\link[rSW2data]{simTiming_ForEachUsedTimeUnit}}.}
+}
\value{
A named numeric vector of length 6.
}
@@ -14,5 +27,5 @@ Calculate variables required to estimate percent C4 species in North America
}
\references{
Teeri J.A., Stowe L.G. (1976) Climatic patterns and the
- distribution of C4 grasses in North America. Oecologia, 23, 1-12.
+distribution of C4 grasses in North America. Oecologia, 23, 1-12.
}
diff --git a/man/sw_exampleData.Rd b/man/sw_exampleData.Rd
index 421fec1f..a88a8b62 100644
--- a/man/sw_exampleData.Rd
+++ b/man/sw_exampleData.Rd
@@ -19,7 +19,8 @@ A dataset containing complete input data for an unspecified location.
site-specific simulation run is discouraged (even though there are many
such examples throughout the documentation of this package).
The recommended approach is to create a clean new object with
- \code{new("swInputData")} and then set all site-specific inputs and
+ the helper constructor \code{swInputData()} (or based on the prototype
+ \code{new("swInputData")}) and then set all site-specific inputs and
parameters. See \var{\dQuote{rSOILWAT2_demo}} vignette.
}
diff --git a/man/sw_exec.Rd b/man/sw_exec.Rd
index aeba80bb..0997a2b2 100644
--- a/man/sw_exec.Rd
+++ b/man/sw_exec.Rd
@@ -7,7 +7,7 @@
sw_exec(
inputData = NULL,
weatherList = NULL,
- dir = "",
+ dir = ".",
files.in = "files.in",
echo = FALSE,
quiet = FALSE
@@ -24,13 +24,15 @@ sw_exec(
\item{dir}{a character vector that represents the path to the input data. Use
with \code{files.in}}
-\item{files.in}{a character vector that represents the partial path of the
-\var{files.in} file}
+\item{files.in}{A character string. The file name (and path relative to
+\code{dir}) of the \var{files} input file that contains information
+about the remaining input files.}
\item{echo}{logical. This option will echo the inputs to the \var{logfile}.
Helpful for debugging.}
-\item{quiet}{logical. Quiet mode doesn't print messages to the \var{logfile}.}
+\item{quiet}{logical. Quiet mode hides any \pkg{SOILWAT2} messages,
+see \code{\link{sw_verbosity}}.}
}
\value{
An object of class \code{\linkS4class{swOutput}}.
@@ -60,7 +62,8 @@ If you have missing weather data, then you have to impute yourself or use the
built-in Markov weather generator (see examples section). If you use the
weather generator, then you have to provide appropriate values for the input
(files) \var{mkv_covar.in} and \var{mkv_prob.in} for your simulation run -
-currently, \pkg{rSOILWAT2} does not contain code to estimate these values.
+see \code{\link{dbW_estimate_WGen_coefs}} or
+\code{\link{dbW_generateWeather}}.
}
\examples{
@@ -105,8 +108,11 @@ sw_in3 <- sw_inputDataFromFiles(dir = path_demo, files.in = "files.in")
## to set up a SQLite database for the weather data)
sw_weath3 <- getWeatherData_folders(
LookupWeatherFolder = file.path(path_demo, "Input"),
- weatherDirName = "data_weather", filebasename = "weath",
- startYear = 1979, endYear = 2010)
+ weatherDirName = "data_weather",
+ filebasename = "weath",
+ startYear = 1979,
+ endYear = 2010
+)
## List of the slots of the input objects of class 'swWeatherData'
utils::str(sw_weath3, max.level = 1)
@@ -162,6 +168,14 @@ sw_out6 <- sw_exec(inputData = sw_in6, weatherList = sw_weath3, quiet = TRUE)
print(round(as.numeric(object.size(sw_out6) / object.size(sw_out5)), 2))
+## ------ Simulation with different SWRC ------------
+if (requireNamespace("curl") && curl::has_internet()) {
+ sw_in7 <- sw_in3
+ swSite_SWRCflags(sw_in7) <- c("vanGenuchten1980", "Rosetta3")
+
+ sw_out7 <- sw_exec(inputData = sw_in7, weatherList = sw_weath3)
+}
+
## See help(package = "rSOILWAT2") for a full list of functions
}
diff --git a/man/sw_inputDataFromFiles.Rd b/man/sw_inputDataFromFiles.Rd
index 5f63b693..f884201c 100644
--- a/man/sw_inputDataFromFiles.Rd
+++ b/man/sw_inputDataFromFiles.Rd
@@ -4,14 +4,18 @@
\alias{sw_inputDataFromFiles}
\title{Read simulation input data from files on disk}
\usage{
-sw_inputDataFromFiles(dir = "", files.in = "files.in")
+sw_inputDataFromFiles(dir = "", files.in = "files.in", quiet = FALSE)
}
\arguments{
-\item{dir}{A character string. The path to the simulation project directory.}
+\item{dir}{a character vector that represents the path to the input data. Use
+with \code{files.in}}
\item{files.in}{A character string. The file name (and path relative to
\code{dir}) of the \var{files} input file that contains information
about the remaining input files.}
+
+\item{quiet}{logical. Quiet mode hides any \pkg{SOILWAT2} messages,
+see \code{\link{sw_verbosity}}.}
}
\value{
An object of class \code{\linkS4class{swInputData}}.
diff --git a/man/sw_outputData.Rd b/man/sw_outputData.Rd
index 2f23d52d..27d0486a 100644
--- a/man/sw_outputData.Rd
+++ b/man/sw_outputData.Rd
@@ -7,7 +7,9 @@
sw_outputData(inputData)
}
\arguments{
-\item{inputData}{An object of class \code{\linkS4class{swInputData}}.}
+\item{inputData}{an object of the \var{S4} class
+\code{\linkS4class{swInputData}} which is generated from
+\code{\link{sw_inputData}} or \code{\link{sw_inputDataFromFiles}}.}
}
\value{
An object of class \code{\linkS4class{swOutput}}.
diff --git a/man/sw_upgrade.Rd b/man/sw_upgrade.Rd
new file mode 100644
index 00000000..feb4de2a
--- /dev/null
+++ b/man/sw_upgrade.Rd
@@ -0,0 +1,100 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/A_swGenericMethods.R, R/B_swFiles.R,
+% R/D_swWeather.R, R/D_swWeatherData.R, R/E_swProd.R, R/F_swSite.R,
+% R/F_swSoils.R, R/G_swOut.R, R/I_swEstab.R, R/K_swContainer.R
+\name{sw_upgrade}
+\alias{sw_upgrade}
+\alias{sw_upgrade,ANY-method}
+\alias{sw_upgrade,swFiles-method}
+\alias{sw_upgrade,swMonthlyScalingParams-method}
+\alias{sw_upgrade,swWeather-method}
+\alias{upgrade_weatherHistory}
+\alias{sw_upgrade,swProd-method}
+\alias{sw_upgrade,swSite-method}
+\alias{sw_upgrade,swSoils-method}
+\alias{sw_upgrade,swOUT-method}
+\alias{sw_upgrade,swEstabSpecies-method}
+\alias{sw_upgrade,swEstab-method}
+\alias{sw_upgrade,swInputData-method}
+\title{Upgrade a \code{rSOILWAT2}-classed object from an older package version}
+\usage{
+sw_upgrade(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{ANY}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swFiles}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swMonthlyScalingParams}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swWeather}(object, verbose = FALSE)
+
+upgrade_weatherHistory(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swProd}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swSite}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swSoils}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swOUT}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swEstabSpecies}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swEstab}(object, verbose = FALSE)
+
+\S4method{sw_upgrade}{swInputData}(object, verbose = FALSE)
+}
+\arguments{
+\item{object}{An object of a \code{rSOILWAT2} class.}
+
+\item{verbose}{A logical value.}
+}
+\value{
+The upgraded \code{object}, if needed, to match the current version
+with missing slots and elements filled with default values.
+}
+\description{
+Missing slots and elements are added and
+take the new default values from \code{SOILWAT2}.
+}
+\section{Details}{
+
+List of changes:
+\itemize{
+\item Changes with \code{v6.0.0}:
+\itemize{
+\item class \code{\linkS4class{swSite}}:
+new slots \code{"swrc_flags"}, \code{"has_swrcp"}, and
+\code{"SoilDensityInputType"}
+\item class \code{\linkS4class{swSoils}}: new slot \code{"SWRCp"}
+\item class \code{\linkS4class{swFiles}}:
+\code{SWRC} parameter input file added as file 6 for a new total of 23
+\item class \code{\linkS4class{swProd}}: new slot \code{"veg_method"}
+}
+\item Changes with \code{v5.4.0}:
+\itemize{
+\item classes \code{\linkS4class{swEstabSpecies}} and \code{\linkS4class{swEstab}}:
+new slot \code{"vegType"}
+}
+\item Changes with \code{v5.2.0}:
+\itemize{
+\item class \code{\linkS4class{swOUT}}:
+\code{"FROZEN"} added as \code{outkey} 28 for a new total of 32
+}
+\item Changes with \code{v3.1.0}:
+\itemize{
+\item class \code{\linkS4class{swOUT}}:
+\code{"BIOMASS"} added as \code{outkey} 31 for a new total of 31
+}
+\item Changes with \code{v2.3.0}:
+\itemize{
+\item class \code{\linkS4class{swOUT}}:
+\code{"SWA"} added as \code{outkey} 8 for a new total of 30
+}
+}
+}
+
+\examples{
+ x <- sw_upgrade(rSOILWAT2::sw_exampleData, verbose = TRUE)
+
+}
diff --git a/man/sw_verbosity.Rd b/man/sw_verbosity.Rd
new file mode 100644
index 00000000..4d54c2aa
--- /dev/null
+++ b/man/sw_verbosity.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Rsw.R
+\name{sw_verbosity}
+\alias{sw_verbosity}
+\title{Turn on/off `SOILWAT2` notes and warnings}
+\usage{
+sw_verbosity(verbose = TRUE)
+}
+\arguments{
+\item{verbose}{A logical value.
+Verbose mode prints any \pkg{SOILWAT2} messages.}
+}
+\value{
+The previous logical value.
+}
+\description{
+Turn on/off `SOILWAT2` notes and warnings
+}
diff --git a/man/sw_weather_data.Rd b/man/sw_weather_data.Rd
new file mode 100644
index 00000000..73a323d5
--- /dev/null
+++ b/man/sw_weather_data.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{sw_weather_data}
+\alias{sw_weather_data}
+\title{\code{rSOILWAT2} weather data functionality}
+\arguments{
+\item{wd}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{weatherData}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{dailySW}{A list of elements of class \code{\linkS4class{swWeatherData}}
+that each hold daily weather data for one calendar year.}
+
+\item{weatherDF}{A \code{data.frame}. Daily weather data where rows represent
+days and columns represent the weather variables
+(see \code{weatherDF_dataColumns}).}
+
+\item{weatherDF_dataColumns}{A vector of character strings. The column
+names of \code{weatherDF} in the correct order for \code{SOILWAT2} including
+calendar year \code{year} (optional) and day of year \code{DOY}, see
+\code{\link[=weather_dataColumns]{weather_dataColumns()}}.}
+
+\item{years}{A numeric vector. The calendar years.}
+
+\item{digits}{An integer value. The number of decimal places for rounding
+weather values.}
+
+\item{round}{An integer value. The number of decimal places for rounding
+weather values.}
+
+\item{weather_tag}{A character string. The base file name without extension
+for \code{SOILWAT2}-formatted input files; default is \code{"weath"}}
+}
+\description{
+\code{rSOILWAT2} weather data functionality
+}
diff --git a/man/sw_weather_database.Rd b/man/sw_weather_database.Rd
new file mode 100644
index 00000000..0b183c97
--- /dev/null
+++ b/man/sw_weather_database.Rd
@@ -0,0 +1,74 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_dbW_WeatherDatabase.R
+\name{sw_weather_database}
+\alias{sw_weather_database}
+\title{Weather data base structure}
+\arguments{
+\item{dbFilePath}{A character string. The file path of the weather database.
+This will be a file of type \code{sqlite3}. In-memory databases are not
+supported.}
+
+\item{site_data}{A data.frame. The site data with column names
+\code{Longitude}, \code{Latitude}, and \code{Label}.}
+
+\item{Site_id}{An integer value. The IDs/database key of the queried site.}
+
+\item{site_id}{An integer value. The IDs/database key of the queried site.}
+
+\item{Site_ids}{An integer vector. The IDs/database keys of the queried sites}
+
+\item{site_ids}{An integer vector. The IDs/database keys of the queried sites}
+
+\item{Labels}{A vector of character strings. The names/labels of
+queried sites.}
+
+\item{Label}{A character string. The name/label of the queried site.}
+
+\item{site_labels}{A vector of character string. The names/labels of
+queried sites.}
+
+\item{site_label}{A character string. The name/label of the queried site.}
+
+\item{lat}{A numeric vector or \code{NULL}. The latitude in decimal degrees
+of \code{WGS84}. Northern latitude are positive, sites on the southern
+hemisphere have negative values.}
+
+\item{long}{A numeric vector or \code{NULL}. The longitude in decimal degrees
+of \code{WGS84}. Eastern longitudes are positive, sites on the western
+hemisphere have negative values.}
+
+\item{Scenario_ids}{An integer vector. The IDs/database keys of the queried
+scenario.}
+
+\item{scen_ids}{An integer vector. The IDs/database keys of the queried
+scenario.}
+
+\item{Scenario_id}{An integer value The ID/database key of the queried
+scenario.}
+
+\item{scenario_id}{An integer value The ID/database key of the queried
+scenario.}
+
+\item{Scenarios}{A vector of character strings. The climate scenarios of
+which the first one is enforced to be \code{scen_ambient}.}
+
+\item{scen_labels}{A vector of character strings. The climate scenarios of
+which the first one is enforced to be \code{scen_ambient}.}
+
+\item{Scenario}{A character string. The name/label of a climate scenario.}
+
+\item{scenario}{A character string. The name/label of a climate scenario.}
+
+\item{scen_ambient}{A character string. The first/default climate scenario.}
+
+\item{startYear}{A numeric value. First calendar year of the weather data.}
+
+\item{endYear}{A numeric value. Last calendar year of the weather data.}
+
+\item{ignore.case}{A logical value.}
+
+\item{verbose}{A logical value.}
+}
+\description{
+Weather data base structure
+}
diff --git a/man/swrc_conversion.Rd b/man/swrc_conversion.Rd
new file mode 100644
index 00000000..1ed71e66
--- /dev/null
+++ b/man/swrc_conversion.Rd
@@ -0,0 +1,294 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{swrc_conversion}
+\alias{swrc_conversion}
+\alias{swrc_swp_to_vwc}
+\alias{swrc_vwc_to_swp}
+\title{Conversion between bulk soil water content and soil water potential}
+\usage{
+swrc_conversion(
+ direction = c("swp_to_vwc", "vwc_to_swp"),
+ x,
+ fcoarse,
+ layer_width,
+ swrc,
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+)
+
+swrc_swp_to_vwc(
+ swp_MPa,
+ fcoarse,
+ layer_width,
+ swrc = list(swrc_name = NULL, ptf_name = NULL, swrcp = NULL),
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+)
+
+swrc_vwc_to_swp(
+ vwcBulk,
+ fcoarse,
+ layer_width,
+ swrc = list(swrc_name = NULL, ptf_name = NULL, swrcp = NULL),
+ sand = NULL,
+ clay = NULL,
+ bdensity = NULL,
+ outer_if_equalsize = FALSE,
+ verbose = FALSE
+)
+}
+\arguments{
+\item{direction}{A character string. Indicates the direction of
+soil water conversion.}
+
+\item{x}{A numeric value, vector, or matrix.
+The soil water values to be converted,
+either soil water potential (units \verb{[MPa]}) of the soil matric component or
+bulk volumetric water content (units \verb{[cm/cm]}).}
+
+\item{fcoarse}{A numeric value or vector.
+Coarse fragments, e.g., gravel, (> 2 mm; units of \verb{[m3/m3]})
+relative to the whole soil of each soil layer.
+\code{fcoarse} is required, for instance, to translate between
+values relative to the matric soil component (< 2 mm fraction) and
+relative to the whole soil (matric soil plus coarse fragments).}
+
+\item{layer_width}{A numeric value or vector.
+Depth interval, width, of each soil layer (units of \code{cm}).
+\code{layer_width} is required to translate between
+soil water content of a soil layer and volumetric water content.}
+
+\item{swrc}{A named list.
+Contains all necessary elements of a \code{SWRC},
+i.e., \code{name} (short for \code{swrc_name}) and \code{swrcp},
+or all necessary elements to estimate parameters of a \code{SWRC} given
+soil parameters, i.e., \code{swrc_name} and \code{ptf_name}.}
+
+\item{sand}{A numeric value or vector.
+Sand content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{clay}{A numeric value or vector.
+Clay content of the matric soil component
+(< 2 mm fraction; units of \verb{[g/g]}) of each soil layer.}
+
+\item{bdensity}{A numeric value or vector.
+Density of the whole soil
+(matric soil plus coarse fragments; units \verb{[g/cm3]}).}
+
+\item{outer_if_equalsize}{A logical value.
+Relevant only if \code{x} of length \code{l} and soils of length \code{d} are equal.
+If \code{TRUE}, then the returned object has a size of \verb{l x d} = \verb{l x l}
+where the \code{d} sets of soil values are repeated for each value of \code{x}.
+If \code{FALSE} (default), then the returned object has a size of \code{l} = \code{d}
+where the the \code{SWRC} conversion is applied to the
+first element of \code{x} and soils, the second elements, and so on.}
+
+\item{verbose}{A logical value. If \code{TRUE}, then display
+\code{SOILWAT2} internal warnings and other messages.}
+
+\item{swp_MPa}{A numeric object. The soil water potential values
+(units \verb{[MPa]}) of the soil matric component to be converted to
+bulk volumetric water content
+(i.e., relative to the whole soil; units \verb{[cm/cm]}).}
+
+\item{vwcBulk}{A numeric object. The volumetric water content values
+(relative to the whole soil; units \verb{[cm/cm]})
+to be converted to soil water potential (units \verb{[MPa]})
+of the soil matric component.}
+}
+\value{
+The dimensions of the output are a function of \code{x} and the
+number of soil values (e.g., rows or length of \code{swrc[["swrcp"]]}).
+The returned object has:
+\itemize{
+\item length \code{l} if both \code{x} and soils are of length \code{l}.
+\item length \code{l} if \code{x} has length \code{l} and there is one soil.
+\item length \code{d} if \code{x} is one value and soils are of length \code{d}.
+\item size \verb{l x d} if \code{x} has length \code{l} and soils are of length \code{d}
+(if \code{l} and \code{d} are not equal or \code{outer_if_equalsize} is \code{TRUE};
+cf. the first case);
+the \code{d} sets of soil values are repeated for each value of \code{x}.
+\item size \verb{l x d} if \code{x} has size \verb{l x d} and there is one soil.
+the soil is repeated for each value of \code{x}.
+\item size \verb{l x d} if \code{x} has size \verb{l x d} and soils are of length \code{d}
+the \code{d} sets of soil values are repeated for each row of \code{x}.
+}
+}
+\description{
+Conversion between bulk soil water content and soil water potential
+}
+\section{Functions}{
+\itemize{
+\item \code{swrc_swp_to_vwc()}: Convenience wrapper
+to convert from \code{SWP} to bulk \code{VWC} with selected \code{SWRC}
+
+\item \code{swrc_vwc_to_swp()}: Convenience wrapper
+to convert from bulk \code{VWC} to matric \code{SWP} with selected \code{SWRC}
+
+}}
+\section{Details}{
+
+\code{\link[=swrc_names]{swrc_names()}} lists implemented \code{SWRCs};
+\code{\link[=ptf_names]{ptf_names()}} lists implemented \code{PTFs}; and
+\code{\link[=check_ptf_availability]{check_ptf_availability()}} checks availability of \code{PTFs}.
+
+
+For backward compatibility, \code{fcoarse} and \code{layer_width} may be missing.
+If they are missing, then the soils are assumed to contain
+\verb{0\%} coarse fragments and be represented by \verb{1 cm} wide soil layers.
+
+
+Arguments \code{sand}, \code{clay}, and \code{bdensity} are only required
+if \code{SWRC} parameter values need to be estimated on the fly,
+i.e., if \code{swrc} does not contain the element \code{swrcp}
+(with suitable \code{SWRC} parameter values).
+This is handled by \code{\link[=ptf_estimate]{ptf_estimate()}} and additionally requires
+the element \code{ptf_name} for argument \code{swrc}.
+
+
+If \code{swrc} contains element \code{swrcp} with one set of \code{SWRC} parameters,
+i.e., one row, then the parameter set is repeated for each value of \code{x}.
+
+
+If \code{vwc} inputs represent the matric component
+(instead of expected bulk values), then set \code{fcoarse} to 0.
+This works, however, only if \code{swrcp} are provided or \code{fcoarse} is not
+utilized by the requested \code{PTF}.
+}
+
+\examples{
+fsand <- c(0.5, 0.3)
+fclay <- c(0.2, 0.1)
+fcrs1 <- c(0, 0)
+fcrs2 <- c(0.4, 0.1)
+
+swrc1 <- list(
+ name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = fsand,
+ clay = fclay,
+ fcoarse = fcrs1,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984"
+ )
+)
+swrc_swp_to_vwc(-1.5, fcoarse = fcrs1, swrc = swrc1)
+swrc_swp_to_vwc(c(-1.5, NA), fcoarse = fcrs1, swrc = swrc1)
+swrc_swp_to_vwc(-1.5, fcoarse = fcrs1, sand = fsand, clay = fclay)
+swrc_vwc_to_swp(c(0.10, 0.15, 0.20), fcoarse = fcrs1, swrc = swrc1)
+swrc_vwc_to_swp(c(0.10, NA, 0.20), fcoarse = fcrs1, swrc = swrc1)
+
+swrc2 <- list(
+ name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = fsand,
+ clay = fclay,
+ fcoarse = fcrs2,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984"
+ )
+)
+swrc_swp_to_vwc(-1.5, fcoarse = fcrs2, swrc = swrc2)
+(1 - fcrs2) * swrc_swp_to_vwc(-1.5, swrc = swrc2)
+swrc_swp_to_vwc(-1.5, fcoarse = fcrs2, sand = fsand, clay = fclay)
+swrc_vwc_to_swp(c(0.10, 0.15, 0.20), fcoarse = fcrs2, swrc = swrc2)
+
+
+# Available water holding capacity "AWC"
+soils <- swSoils_Layers(rSOILWAT2::sw_exampleData)
+p <- ptf_estimate(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"]
+)
+tmp <- swrc_swp_to_vwc(
+ c(-1.5, -0.033),
+ fcoarse = soils[, "gravel_content"],
+ swrc = list(name = "Campbell1974", swrcp = p)
+)
+awc <- diff(c(0, soils[, "depth_cm"])) * as.vector(diff(tmp))
+
+
+# Shape of SWRCs
+theta <- seq(0.05, 0.55, by = 0.001)
+soils <- data.frame(
+ sand_frac = c(sand = 0.92, silty_loam = 0.17, silty_clay = 0.06),
+ clay_frac = c(0.03, 0.13, 0.58),
+ bd = c(1.614, 1.464, 1.437)
+)
+phi <- list(
+ Campbell1974 = swrc_vwc_to_swp(
+ theta,
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ swrc = list(swrc_name = "Campbell1974", ptf_name = "Cosby1984")
+ )
+)
+
+if (check_ptf_availability("Rosetta3")) {
+ phi[["vanGenuchten1980"]] <- swrc_vwc_to_swp(
+ theta,
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ bdensity = soils[, "bd"],
+ swrc = list(swrc_name = "vanGenuchten1980", ptf_name = "Rosetta3")
+ )
+}
+
+# Use PTF "neuroFX2021" to estimate parameters of SWRC `FXW`
+\dontrun{
+# Set neuroFX2021 file path, see details in `ptf_neuroFX2021_for_FXW()`
+options(RSW2_FILENEUROFX2021 = "path/to/sscbd.RData")
+}
+
+if (check_ptf_availability("neuroFX2021")) {
+ phi[["FXW"]] <- swrc_vwc_to_swp(
+ theta,
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ bdensity = soils[, "bd"],
+ swrc = list(swrc_name = "FXW", ptf_name = "neuroFX2021")
+ )
+}
+
+if (interactive() && requireNamespace("graphics")) {
+ par_prev <- graphics::par(mfcol = c(length(phi), 1))
+
+ for (k in seq_along(phi)) {
+ graphics::matplot(
+ theta, -phi[[k]],
+ type = "l",
+ log = "y",
+ xlim = c(0, max(theta)),
+ xlab = "theta [m/m]",
+ ylim = c(1e-4, 1e6),
+ ylab = "-phi [MPa]",
+ main = paste0("Soil Water Retention Curve (", names(phi)[k], ")")
+ )
+ graphics::abline(h = -c(-1.5, -0.033), col = "gray", lty = 3)
+ graphics::legend("topright", rownames(soils), col = 1:3, lty = 1:3)
+ }
+
+ graphics::par(par_prev)
+}
+
+
+}
+\references{
+Cosby, B. J., G. M. Hornberger, R. B. Clapp, & T. R. Ginn. 1984.
+A statistical exploration of the relationships of soil moisture
+characteristics to the physical properties of soils.
+Water Resources Research, 20:682-690, \doi{10.1029/WR020i006p00682}
+}
+\seealso{
+\code{\link[=ptf_estimate]{ptf_estimate()}},
+\code{\link[=check_swrcp]{check_swrcp()}},
+\code{\link[=check_ptf_availability]{check_ptf_availability()}}
+}
diff --git a/man/swrc_names.Rd b/man/swrc_names.Rd
new file mode 100644
index 00000000..2878f73c
--- /dev/null
+++ b/man/swrc_names.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_Pedotransfer_Functions.R
+\name{swrc_names}
+\alias{swrc_names}
+\title{List Soil Water Retention Curves \code{SWRCs}}
+\usage{
+swrc_names()
+}
+\value{
+An integer vector with names of implemented \code{SWRCs}
+}
+\description{
+List Soil Water Retention Curves \code{SWRCs}
+}
+\details{
+Notes:
+The integer values may change with new versions of \code{SOILWAT2.}
+}
+\seealso{
+\code{\link{SWRCs}}, \code{\link[=ptf_names]{ptf_names()}}, \code{\link[=check_ptf_availability]{check_ptf_availability()}}
+}
diff --git a/man/time_columns.Rd b/man/time_columns.Rd
new file mode 100644
index 00000000..165e6e1f
--- /dev/null
+++ b/man/time_columns.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sw_OutputDerived_Functions.R
+\name{time_columns}
+\alias{time_columns}
+\title{Output column indices with time information}
+\usage{
+time_columns(timestep = c("Day", "Week", "Month", "Year"))
+}
+\arguments{
+\item{timestep}{A character string. One of the \pkg{rSOILWAT2} time steps.}
+}
+\description{
+Output column indices with time information
+}
+\examples{
+time_columns("Month")
+
+}
diff --git a/man/update_biomass.Rd b/man/update_biomass.Rd
index 1d603f3f..3c4e2ee8 100644
--- a/man/update_biomass.Rd
+++ b/man/update_biomass.Rd
@@ -16,7 +16,18 @@ update_biomass(
\item{fg}{A character string. One of the functional groups represented by
\pkg{rSOILWAT2}}
-\item{use}{A logical vector.}
+\item{use}{A named logical vector. The names must represent the column
+names of a \code{MonthlyVeg} element of an \code{\linkS4class{swProd}} object}
+
+\item{prod_input}{A data frame. The values that replace the selected
+biomass values.}
+
+\item{prod_default}{A \code{\linkS4class{swProd}} object that contains
+the \code{MonthlyVeg} element with biomass values to be updated.}
+}
+\value{
+The requested \code{MonthlyVeg} element from \code{prod_default} with updated
+values.
}
\description{
Replace selected biomass values of a
diff --git a/man/weatherGenerator_dataColumns.Rd b/man/weatherGenerator_dataColumns.Rd
new file mode 100644
index 00000000..dfa50e67
--- /dev/null
+++ b/man/weatherGenerator_dataColumns.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/swWeatherGenerator.R
+\name{weatherGenerator_dataColumns}
+\alias{weatherGenerator_dataColumns}
+\title{List daily weather variables incorporated in the weather generator}
+\usage{
+weatherGenerator_dataColumns()
+}
+\description{
+List daily weather variables incorporated in the weather generator
+}
diff --git a/man/weather_dataAggFun.Rd b/man/weather_dataAggFun.Rd
new file mode 100644
index 00000000..4e7d2c46
--- /dev/null
+++ b/man/weather_dataAggFun.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/D_swWeatherData.R
+\name{weather_dataAggFun}
+\alias{weather_dataAggFun}
+\title{Functions to summarize currently implemented daily weather variables}
+\usage{
+weather_dataAggFun()
+}
+\value{
+A named vector of functions that summarize
+daily weather variables across time.
+}
+\description{
+Functions to summarize currently implemented daily weather variables
+}
diff --git a/man/weather_dataColumns.Rd b/man/weather_dataColumns.Rd
new file mode 100644
index 00000000..731d499f
--- /dev/null
+++ b/man/weather_dataColumns.Rd
@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/D_swWeatherData.R
+\name{weather_dataColumns}
+\alias{weather_dataColumns}
+\title{List names of currently implemented daily weather variables}
+\usage{
+weather_dataColumns()
+}
+\value{
+A vector of daily weather variable names.
+}
+\description{
+List names of currently implemented daily weather variables
+}
diff --git a/src/Makevars b/src/Makevars
index 8d384c2d..70a22a67 100644
--- a/src/Makevars
+++ b/src/Makevars
@@ -1,27 +1,33 @@
target = SOILWAT2
lib_target = lib$(target).a
path_target = SOILWAT2
-sw_sources = SW_Output_outarray.c
+path_lib = $(path_target)/bin
+sw_sources = src/SW_Output_outarray.c
# to allow MAKEFLAGS="PKG_DEBUG=-DRSWDEBUG" R CMD INSTALL .
-PKG_CPPFLAGS = $(PKG_DEBUG) -DRSOILWAT
+PKG_CPPFLAGS = $(PKG_DEBUG) -DRSOILWAT -I$(path_target)
-PKG_LIBS = -L$(path_target) -l$(target) # $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
+PKG_LIBS = -L$(path_lib) -l$(target) # $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
# Targets
-.PHONY: all $(path_target)/$(lib_target) clean
+.PHONY: all $(path_lib)/$(lib_target) clean shlib-clean
-all: clean $(SHLIB)
+all: $(SHLIB)
-$(SHLIB): $(path_target)/$(lib_target)
+$(SHLIB): $(path_lib)/$(lib_target)
-$(path_target)/$(lib_target):
+$(path_lib)/$(lib_target):
+# Note: `-I..` is required for rSOILWAT2 headers that are included by
+# SOILWAT2 headers (such as `#include "rSW_SoilWater.h"`)
# -@(cd $(path_target) && $(MAKE) compiler_version)
- cd $(path_target) && $(MAKE) $(lib_target) \
- CC="$(CC)" CPPFLAGS="$(ALL_CPPFLAGS)" CFLAGS="$(ALL_CFLAGS)" AR="$(AR)" \
- sw_sources="$(sw_sources)"
+ cd $(path_target) && $(MAKE) lib \
+ CC="$(CC)" CPPFLAGS="$(ALL_CPPFLAGS) -I.." CFLAGS="$(ALL_CFLAGS)" \
+ AR="$(AR)" sw_sources="$(sw_sources)"
+
+shlib-clean: clean
clean:
- rm -f $(SHLIB) $(OBJECTS)
- cd $(path_target) && $(MAKE) clean
+ rm -f $(OBJECTS)
+ MAKEFLAGS= $(MAKE) -C $(path_target) clean
+
diff --git a/src/SOILWAT2 b/src/SOILWAT2
index 0a11f713..34bd4bf6 160000
--- a/src/SOILWAT2
+++ b/src/SOILWAT2
@@ -1 +1 @@
-Subproject commit 0a11f713f9eb3359d10da1e774c54ca5a4046e29
+Subproject commit 34bd4bf69ce9b31f94e639cb1133eeceac1df3df
diff --git a/src/SW_R_init.c b/src/SW_R_init.c
index 30608438..6e311255 100644
--- a/src/SW_R_init.c
+++ b/src/SW_R_init.c
@@ -3,24 +3,44 @@
#include // for NULL
#include
-/* .C calls */
/* .Call calls */
extern SEXP start(SEXP, SEXP, SEXP, SEXP);
-extern SEXP tempError();
-extern SEXP onGetInputDataFromFiles(SEXP);
+extern SEXP tempError(void);
+extern SEXP onGetInputDataFromFiles(SEXP, SEXP);
extern SEXP onGetOutput(SEXP);
-extern SEXP sw_consts();
+extern SEXP rSW2_processAllWeather(SEXP, SEXP);
+extern SEXP rSW2_readAllWeatherFromDisk(SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP sw_consts(void);
+extern SEXP sw_quiet(SEXP);
+extern SEXP rSW2_SWRC_PTF_estimate_parameters(SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP sw_check_SWRC_vs_PTF(SEXP, SEXP);
+extern SEXP rSW2_SWRC_check_parameters(SEXP, SEXP);
+extern SEXP rSW2_SWRC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP rSW2_estimate_PotNatVeg_composition(SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP,
+ SEXP,SEXP, SEXP, SEXP, SEXP,SEXP, SEXP,
+ SEXP, SEXP,SEXP, SEXP, SEXP);
+extern SEXP rSW2_calc_SiteClimate(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
static const R_CallMethodDef CallEntries[] = {
- {"start", (DL_FUNC) &start, 4},
- {"tempError", (DL_FUNC) &tempError, 0},
- {"onGetInputDataFromFiles", (DL_FUNC) &onGetInputDataFromFiles, 1},
- {"onGetOutput", (DL_FUNC) &onGetOutput, 1},
- {"sw_consts", (DL_FUNC) &sw_consts, 0},
+ {"start", (DL_FUNC) &start, 4},
+ {"tempError", (DL_FUNC) &tempError, 0},
+ {"onGetInputDataFromFiles", (DL_FUNC) &onGetInputDataFromFiles, 2},
+ {"onGetOutput", (DL_FUNC) &onGetOutput, 1},
+ {"rSW2_processAllWeather", (DL_FUNC) &rSW2_processAllWeather, 2},
+ {"rSW2_readAllWeatherFromDisk",(DL_FUNC) &rSW2_readAllWeatherFromDisk,5},
+ {"sw_consts", (DL_FUNC) &sw_consts, 0},
+ {"sw_quiet", (DL_FUNC) &sw_quiet, 1},
+ {"rSW2_SWRC_PTF_estimate_parameters", (DL_FUNC) &rSW2_SWRC_PTF_estimate_parameters, 5},
+ {"sw_check_SWRC_vs_PTF", (DL_FUNC) &sw_check_SWRC_vs_PTF, 2},
+ {"rSW2_SWRC_check_parameters", (DL_FUNC) &rSW2_SWRC_check_parameters, 2},
+ {"rSW2_SWRC", (DL_FUNC) &rSW2_SWRC, 6},
+ {"rSW2_estimate_PotNatVeg_composition", (DL_FUNC) &rSW2_estimate_PotNatVeg_composition, 19},
+ {"rSW2_calc_SiteClimate", (DL_FUNC) &rSW2_calc_SiteClimate, 6},
{NULL, NULL, 0}
};
+
/* Register package calls with R */
void R_init_rSOILWAT2(DllInfo *dll) {
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
diff --git a/src/SW_R_lib.c b/src/SW_R_lib.c
index 5dc1b37e..af1e1a23 100644
--- a/src/SW_R_lib.c
+++ b/src/SW_R_lib.c
@@ -6,17 +6,20 @@
*/
// externs `*logfp`, `errstr`, `logged`, `QuietMode`, `EchoInits`
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h" // externs `_firstfile`
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/SW_Defines.h"
-
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Carbon.h" // externs `SW_Carbon`
-#include "SOILWAT2/SW_SoilWater.h" // externs `SW_Soilwat`
-#include "SOILWAT2/SW_VegEstab.h" // externs `SW_VegEstab`
-#include "SOILWAT2/SW_Output.h"
-#include "SOILWAT2/SW_Main_lib.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h" // externs `_firstfile`
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/SW_Defines.h"
+
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Carbon.h" // externs `SW_Carbon`
+#include "SOILWAT2/include/SW_Model.h" // externs `SW_Model`
+#include "SOILWAT2/include/SW_Weather.h" // externs `SW_Weather`
+#include "SOILWAT2/include/SW_Sky.h" // externs `SW_Sky`
+#include "SOILWAT2/include/SW_SoilWater.h" // externs `SW_Soilwat`
+#include "SOILWAT2/include/SW_VegEstab.h" // externs `SW_VegEstab`
+#include "SOILWAT2/include/SW_Output.h"
+#include "SOILWAT2/include/SW_Main_lib.h"
#include "rSW_Files.h"
#include "rSW_Model.h"
@@ -54,6 +57,7 @@ Bool bWeatherList;
/* Local Variables */
/* --------------------------------------------------- */
static SEXP Rlogfile;
+static Bool current_sw_quiet = swFALSE;
@@ -61,6 +65,34 @@ static SEXP Rlogfile;
/* Global Function Definitions */
/* --------------------------------------------------- */
+
+/**
+ * Turn on/off `SOILWAT2` messages including errors, notes, and warnings
+ *
+ * @param verbose A logical value.
+ * @return The previous logical value.
+ */
+SEXP sw_quiet(SEXP quiet) {
+ SEXP prev_quiet;
+
+ PROTECT(prev_quiet = NEW_LOGICAL(1));
+ LOGICAL_POINTER(prev_quiet)[0] = current_sw_quiet;
+
+ if (LOGICAL(coerceVector(quiet, LGLSXP))[0]) {
+ // tell `LogError()` that R should NOT print messages to the console
+ logfp = NULL;
+ current_sw_quiet = swTRUE;
+ } else {
+ // tell `LogError()` that R should print messages to the console
+ logfp = (FILE *) swTRUE; // any non-NULL file pointer
+ current_sw_quiet = swFALSE;
+ }
+
+ UNPROTECT(1);
+ return prev_quiet;
+}
+
+
/**
* Determines if a constant in the Parton equation 2.21 is invalid and would
* thus cause extreme soil temperature values (see SW_Flow_lib.c ~1770)
@@ -117,14 +149,17 @@ void setupSOILWAT2(SEXP inputOptions) {
}
-SEXP onGetInputDataFromFiles(SEXP inputOptions) {
+/**
+ @brief Read inputs from SOILWAT2 input files on disk using SOILWAT2 code
+*/
+SEXP onGetInputDataFromFiles(SEXP inputOptions, SEXP quiet) {
SEXP swInputData, SW_DataList, swLog, oRlogfile;
#ifdef RSWDEBUG
int debug = 0;
#endif
logged = FALSE;
- logfp = NULL;
+ sw_quiet(quiet);
#ifdef RSWDEBUG
if (debug) swprintf("Set log\n");
@@ -142,6 +177,12 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
#endif
rSW_CTL_obtain_inputs(TRUE);
+ // finalize daily weather
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" finalize daily weather ...\n");
+ #endif
+ SW_WTH_finalize_all_weather();
+
// initialize simulation run (based on user inputs)
#ifdef RSWDEBUG
if (debug) swprintf(" init simulation run ...\n");
@@ -149,8 +190,12 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
SW_CTL_init_run();
#ifdef RSWDEBUG
- if (debug) swprintf("onGetInputDataFromFiles: copy data from SOILWAT2 "
- "variables to rSOILWAT2 S4 classes: ");
+ if (debug) {
+ swprintf(
+ "\n'onGetInputDataFromFiles()': "
+ "copy data from SOILWAT2 variables to rSOILWAT2 S4 classes: "
+ );
+ }
#endif
PROTECT(swInputData = MAKE_CLASS("swInputData"));
@@ -167,7 +212,7 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
if (debug) swprintf(" > 'model'");
#endif
- SET_SLOT(SW_DataList, install("weather"), onGet_SW_WTH());
+ SET_SLOT(SW_DataList, install("weather"), onGet_SW_WTH_setup());
#ifdef RSWDEBUG
if (debug) swprintf(" > 'weather-setup'");
#endif
@@ -182,10 +227,20 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
if (debug) swprintf(" > 'climate'");
#endif
- if (LOGICAL(GET_SLOT(GET_SLOT(SW_DataList, install("weather")), install("use_weathergenerator")))[0]) {
+ if (
+ LOGICAL(
+ GET_SLOT(
+ GET_SLOT(
+ SW_DataList,
+ install("weather")
+ ),
+ install("use_weathergenerator")
+ )
+ )[0]
+ ) {
SET_SLOT(SW_DataList, install("markov"), onGet_MKV());
#ifdef RSWDEBUG
- if (debug) swprintf(" > 'mwgen'");
+ if (debug) swprintf(" > 'weather generator'");
#endif
}
@@ -199,9 +254,9 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
if (debug) swprintf(" > 'site'");
#endif
- SET_SLOT(SW_DataList, install("soils"), onGet_SW_LYR());
+ SET_SLOT(SW_DataList, install("soils"), onGet_SW_SOILS());
#ifdef RSWDEBUG
- if (debug) swprintf(" > 'soils'");
+ if (debug) swprintf(" > 'soils' + 'swrc parameters'");
#endif
SET_SLOT(SW_DataList, install("estab"), onGet_SW_VES());
@@ -240,6 +295,14 @@ SEXP onGetInputDataFromFiles(SEXP inputOptions) {
return SW_DataList;
}
+
+/**
+ @brief Run a SOILWAT2 simulation
+
+ - Copies R inputs to C variables
+ - Executes a SOILWAT2 simulation
+ - Copies output to R output variable
+*/
SEXP start(SEXP inputOptions, SEXP inputData, SEXP weatherList, SEXP quiet) {
SEXP outputData, swLog, oRlogfile;
#ifdef RSWDEBUG
@@ -247,13 +310,7 @@ SEXP start(SEXP inputOptions, SEXP inputData, SEXP weatherList, SEXP quiet) {
#endif
logged = FALSE;
- if (LOGICAL(coerceVector(quiet, LGLSXP))[0]) {
- // tell 'LogError' that R should NOT print messages to the console
- logfp = NULL;
- } else {
- // tell 'LogError' that R should print messages to the console
- logfp = (FILE *) swTRUE; // any non-NULL file pointer
- }
+ sw_quiet(quiet);
if (isNull(inputData)) {
useFiles = TRUE;
@@ -289,6 +346,12 @@ SEXP start(SEXP inputOptions, SEXP inputData, SEXP weatherList, SEXP quiet) {
#endif
rSW_CTL_obtain_inputs(useFiles);
+ // finalize daily weather
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" finalize daily weather ...\n");
+ #endif
+ SW_WTH_finalize_all_weather();
+
// initialize simulation run (based on user inputs)
#ifdef RSWDEBUG
if (debug) swprintf(" init simulation run ...");
@@ -326,64 +389,306 @@ SEXP start(SEXP inputOptions, SEXP inputData, SEXP weatherList, SEXP quiet) {
}
+/**
+ @brief Process daily driving (weather) variables using SOILWAT2 code
+
+ Applies additive/multiplicative scaling parameters and
+ uses imputation/weather generator to fill missing values
+*/
+SEXP rSW2_processAllWeather(SEXP weatherList, SEXP inputData) {
+ SEXP res;
+ #ifdef RSWDEBUG
+ int debug = 0;
+ #endif
+
+
+ #ifdef RSWDEBUG
+ if (debug) swprintf("\n'rSW2_processAllWeather': data preparation: ");
+ #endif
+
+ // Copy `swInputData` to global variable `InputData` which is used
+ // by `onSet_XXX()` functions
+ InputData = inputData;
+
+ // Copy `weatherList` to global variable `WeatherList` which is used
+ // by `onSet_WTH_DATA()` if `bWeatherList`
+ bWeatherList = TRUE;
+ WeatherList = weatherList;
+
+
+ // setup and construct model (independent of inputs)
+ #ifdef RSWDEBUG
+ if (debug) swprintf("'setup' > ");
+ #endif
+ SW_CTL_setup_model(_firstfile);
+
+ // `onSet_WTH_DATA()` requires correct `endyr` and `startyr` of `SW_Model`
+ #ifdef RSWDEBUG
+ if (debug) swprintf("'model' > ");
+ #endif
+ onSet_SW_MDL(GET_SLOT(inputData, install("years")));
+
+ // `onSet_WTH_DATA()` requires additive/multiplicative scaling parameters
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > 'weather-setup'");
+ #endif
+ onSet_SW_WTH_setup(GET_SLOT(inputData, install("weather")));
+
+ // `onSet_WTH_DATA()` requires ready-to-go weather generator
+ if (
+ LOGICAL(
+ GET_SLOT(
+ GET_SLOT(
+ inputData,
+ install("weather")
+ ),
+ install("use_weathergenerator")
+ )
+ )[0]
+ ) {
+ onSet_MKV(GET_SLOT(inputData, install("markov")));
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > 'weather generator'.\n");
+ #endif
+ }
+
+
+ // Process weather data
+ #ifdef RSWDEBUG
+ if (debug) swprintf("'rSW2_processAllWeather': process weather data");
+ #endif
+ onSet_WTH_DATA();
+
+
+ // Finalize daily weather (weather generator & monthly scaling)
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > finalize daily weather.\n");
+ #endif
+ SW_WTH_finalize_all_weather();
+
+
+ // Return processed weather data
+ PROTECT(res = onGet_WTH_DATA());
+
+ UNPROTECT(1);
+ return res;
+}
+
+
+
+
+/**
+ @brief Read daily driving (weather) variables from disk using SOILWAT2 code
+
+ Applies additive/multiplicative scaling parameters and
+ uses imputation/weather generator to fill missing values
+*/
+SEXP rSW2_readAllWeatherFromDisk(
+ SEXP path,
+ SEXP name_prefix,
+ SEXP startYear,
+ SEXP endYear,
+ SEXP dailyInputFlags
+) {
+ SEXP res;
+ int i;
+
+ #ifdef RSWDEBUG
+ int debug = 0;
+ #endif
+
+ /* Convert inputs to correct type */
+ path = PROTECT(AS_CHARACTER(path));
+ name_prefix = PROTECT(AS_CHARACTER(name_prefix));
+ startYear = PROTECT(coerceVector(startYear, INTSXP));
+ endYear = PROTECT(coerceVector(endYear, INTSXP));
+ dailyInputFlags = PROTECT(coerceVector(dailyInputFlags, LGLSXP));
+
+ /* Create convenience pointers */
+ int *xdif = LOGICAL(dailyInputFlags); /* LGLSXP are internally coded as int */
+
+
+ #ifdef RSWDEBUG
+ if (debug) swprintf("\n'rSW2_readAllWeatherFromDisk': data preparation: ");
+ #endif
+ SW_Model.startyr = INTEGER(startYear)[0];
+ SW_Model.endyr = INTEGER(endYear)[0];
+
+ strcpy(SW_Weather.name_prefix, CHAR(STRING_ELT(path, 0)));
+ strcat(SW_Weather.name_prefix, "/");
+ strcat(SW_Weather.name_prefix, CHAR(STRING_ELT(name_prefix, 0)));
+
+ // read only from files
+ SW_Weather.use_weathergenerator_only = FALSE; // no weather generator
+ SW_Weather.generateWeatherMethod = 0;
+
+ SW_Weather.use_cloudCoverMonthly = FALSE; // don't interpolate monthly values
+ SW_Weather.use_windSpeedMonthly = FALSE; // don't interpolate monthly values
+ SW_Weather.use_humidityMonthly = FALSE; // don't interpolate monthly values
+ for (i = 0; i < MAX_MONTHS; i++) {
+ SW_Sky.cloudcov[i] = SW_MISSING;
+ SW_Sky.windspeed[i] = SW_MISSING;
+ SW_Sky.r_humidity[i] = SW_MISSING;
+ }
+
+ for (i = 0; i < MAX_INPUT_COLUMNS; i++) {
+ SW_Weather.dailyInputFlags[i] = xdif[i] ? swTRUE : swFALSE;
+ };
+
+ set_dailyInputIndices(
+ SW_Weather.dailyInputFlags,
+ SW_Weather.dailyInputIndices,
+ &SW_Weather.n_input_forcings
+ );
+
+ check_and_update_dailyInputFlags(
+ SW_Weather.use_cloudCoverMonthly,
+ SW_Weather.use_humidityMonthly,
+ SW_Weather.use_windSpeedMonthly,
+ SW_Weather.dailyInputFlags
+ );
+
+ // no monthly scaling
+ for (i = 0; i < MAX_MONTHS; i++) {
+ SW_Weather.scale_precip[i] = 1;
+ SW_Weather.scale_temp_max[i] = 0;
+ SW_Weather.scale_temp_min[i] = 0;
+ SW_Weather.scale_skyCover[i] = 0;
+ SW_Weather.scale_wind[i] = 1;
+ SW_Weather.scale_rH[i] = 0;
+ SW_Weather.scale_actVapPress[i] = 1;
+ SW_Weather.scale_shortWaveRad[i] = 1;
+ }
+
+
+ // Process weather data
+ #ifdef RSWDEBUG
+ if (debug) swprintf("'rSW2_readAllWeatherFromDisk': process weather data");
+ #endif
+ // using global variables: SW_Weather, SW_Model, SW_Sky
+ SW_WTH_read();
+
+ // Finalize daily weather (weather generator & monthly scaling)
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > finalize daily weather.\n");
+ #endif
+ SW_WTH_finalize_all_weather();
+
+
+ // Return processed weather data
+ // using global variables: SW_Weather
+ res = PROTECT(onGet_WTH_DATA());
+
+ UNPROTECT(6);
+ return res;
+}
+
+
+
+
/** Expose SOILWAT2 constants and defines to internal R code of rSOILWAT2
- @return A list with six elements: one element `kINT` for integer constants;
- other elements contain vegetation keys, `VegTypes`; output keys, `OutKeys`;
- output periods, `OutPeriods`; output aggregation types, `OutAggs`; and names of
- input files, `InFiles`.
+ @return A list with six elements:
+ one element `kINT` for integer constants;
+ other elements contain vegetation keys, `VegTypes`;
+ output keys, `OutKeys`;
+ output periods, `OutPeriods`;
+ output aggregation types, `OutAggs`;
+ and indices of input files, `InFiles`.
*/
SEXP sw_consts(void) {
#ifdef RSWDEBUG
int debug = 0;
#endif
- const int nret = 7; // length of cret
- const int nINT = 10; // length of vINT and cINT
+ const int nret = 9; // length of cret
+ const int nINT = 14; // length of vINT and cINT
const int nNUM = 1; // length of vNUM and cNUM
#ifdef RSWDEBUG
if (debug) swprintf("sw_consts: define variables ... ");
#endif
- SEXP ret, cnames, ret_num, ret_int, ret_int2, ret_str1, ret_str2, ret_str3,
- ret_infiles;
+ SEXP
+ ret,
+ cnames,
+ ret_num,
+ ret_int,
+ ret_int2,
+ ret_str1, ret_str2, ret_str3,
+ ret_infiles,
+ ret_swrc,
+ ret_ptf;
int i;
int *pvINT;
double *pvNUM;
- char *cret[] = {"kNUM", "kINT", "VegTypes", "OutKeys", "OutPeriods",
- "OutAggs", "InFiles"};
-
+ char *cret[] = {
+ "kNUM",
+ "kINT",
+ "VegTypes",
+ "OutKeys", "OutPeriods", "OutAggs",
+ "InFiles",
+ "SWRC_types",
+ "PTF_types"
+ };
+
+ // Miscellaneous numerical constants
double vNUM[] = {SW_MISSING};
char *cNUM[] = {"SW_MISSING"};
- int vINT[] = {SW_NFILES, MAX_LAYERS, MAX_TRANSP_REGIONS, MAX_NYEAR, eSW_NoTime,
- SW_OUTNPERIODS, SW_OUTNKEYS, SW_NSUMTYPES, NVEGTYPES, OUT_DIGITS};
- char *cINT[] = {"SW_NFILES", "MAX_LAYERS", "MAX_TRANSP_REGIONS", "MAX_NYEAR",
+ // Miscellaneous integer constants
+ int vINT[] = {
+ SW_NFILES, MAX_LAYERS, MAX_TRANSP_REGIONS, MAX_NYEAR,
+ SWRC_PARAM_NMAX,
+ eSW_NoTime, SW_OUTNPERIODS, SW_OUTNKEYS, SW_NSUMTYPES, NVEGTYPES,
+ OUT_DIGITS,
+ N_SWRCs, N_PTFs, MAX_INPUT_COLUMNS
+ };
+ char *cINT[] = {
+ "SW_NFILES", "MAX_LAYERS", "MAX_TRANSP_REGIONS", "MAX_NYEAR",
+ "SWRC_PARAM_NMAX",
"eSW_NoTime", "SW_OUTNPERIODS", "SW_OUTNKEYS", "SW_NSUMTYPES", "NVEGTYPES",
- "OUT_DIGITS"};
+ "OUT_DIGITS",
+ "N_SWRCs", "N_PTFs", "MAX_INPUT_COLUMNS"
+ };
+
+ // Vegetation types
+ // NOTE: order must match their numeric values, i.e., how SOILWAT2 uses them
int vINT2[] = {SW_TREES, SW_SHRUB, SW_FORBS, SW_GRASS};
char *cINT2[] = {"SW_TREES", "SW_SHRUB", "SW_FORBS", "SW_GRASS"};
- char *vSTR1[] = { SW_WETHR, SW_TEMP, SW_PRECIP, SW_SOILINF, SW_RUNOFF, SW_ALLH2O, SW_VWCBULK,
- SW_VWCMATRIC, SW_SWCBULK, SW_SWABULK, SW_SWAMATRIC, SW_SWA, SW_SWPMATRIC,
- SW_SURFACEW, SW_TRANSP, SW_EVAPSOIL, SW_EVAPSURFACE, SW_INTERCEPTION,
- SW_LYRDRAIN, SW_HYDRED, SW_ET, SW_AET, SW_PET, SW_WETDAY, SW_SNOWPACK,
- SW_DEEPSWC, SW_SOILTEMP, SW_FROZEN,
- SW_ALLVEG, SW_ESTAB, SW_CO2EFFECTS, SW_BIOMASS }; // TODO: this is identical to SW_Output.c/key2str
- char *cSTR1[] = {"SW_WETHR", "SW_TEMP", "SW_PRECIP", "SW_SOILINF", "SW_RUNOFF",
+ // Output categories
+ // NOTE: `cSTR1` must agree with SW_Output.c/key2str[]
+ char *cSTR1[] = {
+ "SW_WETHR", "SW_TEMP", "SW_PRECIP", "SW_SOILINF", "SW_RUNOFF",
"SW_ALLH2O", "SW_VWCBULK", "SW_VWCMATRIC", "SW_SWCBULK", "SW_SWABULK",
"SW_SWAMATRIC", "SW_SWA", "SW_SWPMATRIC", "SW_SURFACEW", "SW_TRANSP", "SW_EVAPSOIL",
"SW_EVAPSURFACE", "SW_INTERCEPTION", "SW_LYRDRAIN", "SW_HYDRED", "SW_ET", "SW_AET",
"SW_PET", "SW_WETDAY", "SW_SNOWPACK", "SW_DEEPSWC", "SW_SOILTEMP", "SW_FROZEN", "SW_ALLVEG",
- "SW_ESTAB", "SW_CO2EFFECTS", "SW_BIOMASS"};
- char *vSTR2[] = {SW_DAY, SW_WEEK, SW_MONTH, SW_YEAR}; // TODO: this is identical to SW_Output.c/pd2str
+ "SW_ESTAB", "SW_CO2EFFECTS", "SW_BIOMASS"
+ };
+
+ // Output time steps
+ // Note: `cSTR2` must agree with SW_Output.c/pd2longstr[]
char *cSTR2[] = {"SW_DAY", "SW_WEEK", "SW_MONTH", "SW_YEAR"};
- char *vSTR3[] = {SW_SUM_OFF, SW_SUM_SUM, SW_SUM_AVG, SW_SUM_FNL}; // TODO: this is identical to SW_Output.c/styp2str
+
+ // Output aggregation types
+ // Note: `cSTR3` must agree with SW_Output.c/styp2str
char *cSTR3[] = {"SW_SUM_OFF", "SW_SUM_SUM", "SW_SUM_AVG", "SW_SUM_FNL"};
- char *cInF[] = {"eFirst", "eModel", "eLog", "eSite", "eLayers", "eWeather",
- "eMarkovProb", "eMarkovCov", "eSky", "eVegProd", "eVegEstab", "eCarbon", "eSoilwat",
- "eOutput", "eOutputDaily","eOutputWeekly","eOutputMonthly","eOutputYearly",
- "eOutputDaily_soil","eOutputWeekly_soil","eOutputMonthly_soil","eOutputYearly_soil"}; // TODO: this must match SW_Files.h/SW_FileIndex
+
+ // SOILWAT2 input files
+ // Note: `cInF` must agree with SW_Files.h/SW_FileIndex
+ char *cInF[] = {
+ "eFirst",
+ "eModel", "eLog",
+ "eSite", "eLayers", "eSWRCp",
+ "eWeather", "eMarkovProb", "eMarkovCov", "eSky",
+ "eVegProd", "eVegEstab",
+ "eCarbon",
+ "eSoilwat",
+ "eOutput", "eOutputDaily", "eOutputWeekly", "eOutputMonthly", "eOutputYearly",
+ "eOutputDaily_soil", "eOutputWeekly_soil", "eOutputMonthly_soil", "eOutputYearly_soil"
+ };
+
// create vector of numeric/real/double constants
#ifdef RSWDEBUG
@@ -431,7 +736,7 @@ SEXP sw_consts(void) {
PROTECT(ret_str1 = allocVector(STRSXP, SW_OUTNKEYS));
PROTECT(cnames = allocVector(STRSXP, SW_OUTNKEYS));
for (i = 0; i < SW_OUTNKEYS; i++) {
- SET_STRING_ELT(ret_str1, i, mkChar(vSTR1[i]));
+ SET_STRING_ELT(ret_str1, i, mkChar(key2str[i]));
SET_STRING_ELT(cnames, i, mkChar(cSTR1[i]));
}
namesgets(ret_str1, cnames);
@@ -443,7 +748,7 @@ SEXP sw_consts(void) {
PROTECT(ret_str2 = allocVector(STRSXP, SW_OUTNPERIODS));
PROTECT(cnames = allocVector(STRSXP, SW_OUTNPERIODS));
for (i = 0; i < SW_OUTNPERIODS; i++) {
- SET_STRING_ELT(ret_str2, i, mkChar(vSTR2[i]));
+ SET_STRING_ELT(ret_str2, i, mkChar(pd2longstr[i]));
SET_STRING_ELT(cnames, i, mkChar(cSTR2[i]));
}
namesgets(ret_str2, cnames);
@@ -455,7 +760,7 @@ SEXP sw_consts(void) {
PROTECT(ret_str3 = allocVector(STRSXP, SW_NSUMTYPES));
PROTECT(cnames = allocVector(STRSXP, SW_NSUMTYPES));
for (i = 0; i < SW_NSUMTYPES; i++) {
- SET_STRING_ELT(ret_str3, i, mkChar(vSTR3[i]));
+ SET_STRING_ELT(ret_str3, i, mkChar(styp2str[i]));
SET_STRING_ELT(cnames, i, mkChar(cSTR3[i]));
}
namesgets(ret_str3, cnames);
@@ -473,6 +778,32 @@ SEXP sw_consts(void) {
}
namesgets(ret_infiles, cnames);
+ // create vector of SWRC types
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" create ret_swrc ...");
+ #endif
+ PROTECT(ret_swrc = allocVector(INTSXP, N_SWRCs));
+ pvINT = INTEGER(ret_swrc);
+ PROTECT(cnames = allocVector(STRSXP, N_SWRCs));
+ for (i = 0; i < N_SWRCs; i++) {
+ pvINT[i] = i;
+ SET_STRING_ELT(cnames, i, mkChar(swrc2str[i]));
+ }
+ namesgets(ret_swrc, cnames);
+
+ // create vector of PTF types
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" create ret_ptf ...");
+ #endif
+ PROTECT(ret_ptf = allocVector(INTSXP, N_PTFs));
+ pvINT = INTEGER(ret_ptf);
+ PROTECT(cnames = allocVector(STRSXP, N_PTFs));
+ for (i = 0; i < N_PTFs; i++) {
+ pvINT[i] = i;
+ SET_STRING_ELT(cnames, i, mkChar(ptf2str[i]));
+ }
+ namesgets(ret_ptf, cnames);
+
// combine vectors into a list and return
#ifdef RSWDEBUG
@@ -490,7 +821,10 @@ SEXP sw_consts(void) {
SET_VECTOR_ELT(ret, 4, ret_str2);
SET_VECTOR_ELT(ret, 5, ret_str3);
SET_VECTOR_ELT(ret, 6, ret_infiles);
+ SET_VECTOR_ELT(ret, 7, ret_swrc);
+ SET_VECTOR_ELT(ret, 8, ret_ptf);
+ // clean up
UNPROTECT(nret * 2 + 2);
#ifdef RSWDEBUG
if (debug) swprintf(" ... done.\n");
@@ -498,3 +832,369 @@ SEXP sw_consts(void) {
return ret;
}
+
+
+
+/**
+ @brief Estimate parameters of selected soil water retention curve (SWRC)
+ using selected pedotransfer function (PTF)
+
+ See SOILWAT2's `SWRC_PTF_estimate_parameters()`, `swrc2str[]` and `ptf2str[]`.
+
+ @param[in] ptf_type Identification number of selected PTF
+ @param[in] sand Sand content of the matric soil (< 2 mm fraction) [g/g]
+ @param[in] clay Clay content of the matric soil (< 2 mm fraction) [g/g]
+ @param[in] fcoarse Coarse fragments (> 2 mm; e.g., gravel)
+ of the whole soil [m3/m3]
+ @param[in] bdensity Density of the whole soil
+ (matric soil plus coarse fragments) [g/cm3];
+ accepts `NULL` if not used by `PTF`
+
+ @return Matrix of estimated SWRC parameters
+*/
+SEXP rSW2_SWRC_PTF_estimate_parameters(
+ SEXP ptf_type,
+ SEXP sand,
+ SEXP clay,
+ SEXP fcoarse,
+ SEXP bdensity
+) {
+ int nlyrs = length(sand);
+ Rboolean has_bd = !isNull(bdensity);
+
+ /* Check inputs */
+ if (
+ nlyrs != length(clay) ||
+ nlyrs != length(fcoarse) ||
+ nlyrs != length(ptf_type) ||
+ (has_bd && nlyrs != length(bdensity))
+ ) {
+ error("inputs are not of the same length.");
+ }
+
+ /* Convert inputs to correct type */
+ ptf_type = PROTECT(coerceVector(ptf_type, INTSXP));
+ sand = PROTECT(coerceVector(sand, REALSXP));
+ clay = PROTECT(coerceVector(clay, REALSXP));
+ fcoarse = PROTECT(coerceVector(fcoarse, REALSXP));
+ if (has_bd) {
+ bdensity = PROTECT(coerceVector(bdensity, REALSXP));
+ } else {
+ // Set `bdensity` from `NULL` to array of `SW_MISSING` of appropriate length
+ // `SW_MISSING` is the expected value by SOILWAT2
+ bdensity = PROTECT(allocVector(REALSXP, nlyrs));
+ for (int i = 0; i < nlyrs; i++) {
+ REAL(bdensity)[i] = SW_MISSING;
+ }
+ }
+
+ /* Allocate memory for SWRC parameters */
+ SEXP
+ swrcpk = PROTECT(allocVector(REALSXP, SWRC_PARAM_NMAX)),
+ res_swrcp = PROTECT(allocMatrix(REALSXP, nlyrs, SWRC_PARAM_NMAX));
+
+ /* Create convenience pointers */
+ unsigned int
+ *xptf_type = (unsigned int *) INTEGER(ptf_type);
+
+ double
+ *xsand = REAL(sand),
+ *xclay = REAL(clay),
+ *xcoarse = REAL(fcoarse),
+ *xbd = REAL(bdensity),
+ *xres = REAL(res_swrcp);
+
+
+ /* Loop over soil layers */
+ /* Ideally, SOILWAT2's `SWRC_PTF_estimate_parameters()`
+ would loop over soil layers internally,
+ but SOILWAT2 uses a list of soil layer structures instead of an array
+ */
+ int k1, k2;
+
+ for (k1 = 0; k1 < nlyrs; k1++) {
+ SWRC_PTF_estimate_parameters(
+ xptf_type[k1],
+ REAL(swrcpk),
+ xsand[k1],
+ xclay[k1],
+ xcoarse[k1],
+ xbd[k1]
+ );
+
+ for (k2 = 0; k2 < SWRC_PARAM_NMAX; k2++) {
+ xres[k1 + nlyrs * k2] = REAL(swrcpk)[k2];
+ }
+ }
+
+ UNPROTECT(7);
+
+ return res_swrcp;
+}
+
+
+/**
+ @brief Check whether PTF and SWRC are compatible and implemented in `SOILWAT2`
+
+ @param[in] swrc_name Name of SWRC
+ @param[in] ptf_name Name of PTF
+
+ @return A logical value indicating if SWRC and PTF are compatible.
+*/
+SEXP sw_check_SWRC_vs_PTF(SEXP swrc_name, SEXP ptf_name) {
+ SEXP res;
+ PROTECT(res = NEW_LOGICAL(1));
+ LOGICAL(res)[0] = swFALSE;
+
+ PROTECT(swrc_name = AS_CHARACTER(swrc_name));
+ PROTECT(ptf_name = AS_CHARACTER(ptf_name));
+
+ if (
+ !isNull(swrc_name) &&
+ !isNull(ptf_name) &&
+ strlen(CHAR(STRING_ELT(swrc_name, 0))) < 64 &&
+ strlen(CHAR(STRING_ELT(ptf_name, 0))) < 64
+ ) {
+ char
+ sw_swrc_name[64],
+ sw_ptf_name[64];
+
+ strcpy(sw_swrc_name, CHAR(STRING_ELT(swrc_name, 0)));
+ strcpy(sw_ptf_name, CHAR(STRING_ELT(ptf_name, 0)));
+
+ LOGICAL(res)[0] = check_SWRC_vs_PTF(sw_swrc_name, sw_ptf_name);
+ }
+
+ UNPROTECT(3);
+ return res;
+}
+
+
+/**
+ @brief Check Soil Water Retention Curve (SWRC) parameters
+
+ See SOILWAT2 function `SWRC_check_parameters()`.
+
+ @param[in] swrc_type Identification number of selected SWRC
+ @param[in] *swrcp SWRC parameters;
+ matrix (one row per set of parameters) or vector (treated as one set)
+
+ @return A logical vector indicating if parameters passed the checks.
+*/
+SEXP rSW2_SWRC_check_parameters(SEXP swrc_type, SEXP swrcp) {
+ /* Convert inputs to correct type */
+ swrcp = PROTECT(coerceVector(swrcp, REALSXP));
+ swrc_type = PROTECT(coerceVector(swrc_type, INTSXP));
+
+
+ /* Check SWRC parameters */
+ int
+ nrp, ncp,
+ nlyrs = length(swrc_type);
+
+ if (isMatrix(swrcp)) {
+ nrp = nrows(swrcp);
+ ncp = ncols(swrcp);
+ } else if (isVector(swrcp)) {
+ nrp = 1;
+ ncp = length(swrcp);
+ } else {
+ nrp = 0;
+ ncp = 0;
+ }
+
+ if (nlyrs != nrp) {
+ UNPROTECT(2); /* unprotect: swrcp, swrc_type */
+ error("`nrows(swrcp)` disagrees with length of `swrc_type`.");
+ }
+
+ if (ncp != SWRC_PARAM_NMAX) {
+ UNPROTECT(2); /* unprotect: swrcp, swrc_type */
+ error("`ncols(swrcp)` disagrees with required number of SWRC parameters.");
+ }
+
+
+ /* Allocate memory for result */
+ SEXP res = PROTECT(allocVector(LGLSXP, nlyrs));
+
+
+ /* Create convenience pointers */
+ unsigned int *xswrc_type = (unsigned int *) INTEGER(swrc_type);
+ int *xres = LOGICAL(res); /* LGLSXP are internally coded as int */
+ double *xswrcp = REAL(swrcp);
+
+
+ /* Loop over soil layers */
+ /* Ideally, SOILWAT2's `SWRC_check_parameters()`
+ would loop over soil layers internally,
+ but SOILWAT2 uses a list of soil layer structures instead of an array
+ */
+ int k1, k2;
+ double swrcpk[SWRC_PARAM_NMAX];
+
+ for (k1 = 0; k1 < nlyrs; k1++) {
+ for (k2 = 0; k2 < SWRC_PARAM_NMAX; k2++) {
+ swrcpk[k2] = xswrcp[k1 + nlyrs * k2];
+ }
+
+ xres[k1] = SWRC_check_parameters(xswrc_type[k1], swrcpk);
+ }
+
+ UNPROTECT(3);
+
+ return res;
+}
+
+
+
+/**
+ @brief Convert between soil water content and soil water potential using
+ specified soil water retention curve (SWRC)
+
+ See SOILWAT2 function `SWRC_SWCtoSWP()` and `SWRC_SWPtoSWC()`.
+
+ @param[in] x
+ Soil water content in the layer [cm] or soil water potential [-bar]\
+ @param[in] direction Direction of conversion, 1: SWP->SWC; 2: SWC->SWP
+ @param[in] swrc_type Identification number of selected SWRC
+ @param[in] *swrcp Vector or matrix of SWRC parameters
+ @param[in] fcoarse Coarse fragments (> 2 mm; e.g., gravel)
+ of the whole soil [m3/m3]
+ @param[in] width Soil layer width [cm]
+
+ @return Vector of soil water potential [-bar] or soil water content [cm]
+**/
+SEXP rSW2_SWRC(
+ SEXP x,
+ SEXP direction,
+ SEXP swrc_type,
+ SEXP swrcp,
+ SEXP fcoarse,
+ SEXP width
+) {
+ int xdirection = asInteger(direction);
+
+ if (xdirection != 1 && xdirection != 2) {
+ error("`direction` must be either SWP->SWC(1) or SWC->SWP(2).");
+ }
+
+ /* Check dimensions */
+ int nlyrs = length(width);
+
+ if (nlyrs != length(fcoarse)) {
+ error("`width` and `fcoarse` are not of the same length.");
+ }
+
+ if (nlyrs != length(x)) {
+ error("`length(x)` is not equal to the number of soil layers.");
+ }
+
+ if (nlyrs != length(swrc_type)) {
+ error("`swrc_type` is not equal to the number of soil layers.");
+ }
+
+
+ /* Convert inputs to correct type */
+ x = PROTECT(coerceVector(x, REALSXP));
+ fcoarse = PROTECT(coerceVector(fcoarse, REALSXP));
+ width = PROTECT(coerceVector(width, REALSXP));
+ swrcp = PROTECT(coerceVector(swrcp, REALSXP));
+ swrc_type = PROTECT(coerceVector(swrc_type, INTSXP));
+
+
+ /* Check SWRC parameters */
+ int nrp, ncp;
+
+ if (isMatrix(swrcp)) {
+ nrp = nrows(swrcp);
+ ncp = ncols(swrcp);
+ } else if (isVector(swrcp)) {
+ nrp = 1;
+ ncp = length(swrcp);
+ } else {
+ nrp = 0;
+ ncp = 0;
+ }
+
+ if (nlyrs != nrp) {
+ UNPROTECT(5); /* unprotect: swrcp, width, fcoarse, x, swrc_type */
+ error("`nrows(swrcp)` disagrees with number of soil layers.");
+ }
+
+ if (ncp != SWRC_PARAM_NMAX) {
+ UNPROTECT(5); /* unprotect: swrcp, width, fcoarse, x, swrc_type */
+ error("`ncols(swrcp)` disagrees with required number of SWRC parameters.");
+ }
+
+
+ /* Allocate memory for result */
+ SEXP res = PROTECT(allocVector(REALSXP, nlyrs));
+
+
+ /* Create convenience pointers */
+ unsigned int
+ *xswrc_type = (unsigned int *) INTEGER(swrc_type);
+
+ double
+ *xres = REAL(res),
+ *xx = REAL(x),
+ *xswrcp = REAL(swrcp),
+ *xcoarse = REAL(fcoarse),
+ *xwidth = REAL(width);
+
+
+ /* Loop over soil layers */
+ /* Ideally, SOILWAT2's `SWRC_SWPtoSWC()` and `SWRC_SWCtoSWP()`
+ would loop over soil layers internally,
+ but SOILWAT2 uses a list of soil layer structures instead of an array
+ */
+ int k1, k2;
+ double swrcpk[SWRC_PARAM_NMAX];
+
+ for (k1 = 0; k1 < nlyrs; k1++) {
+ for (k2 = 0; k2 < SWRC_PARAM_NMAX; k2++) {
+ swrcpk[k2] = xswrcp[k1 + nlyrs * k2];
+ }
+
+ if (R_FINITE(xx[k1]) && R_FINITE(xcoarse[k1]) && R_FINITE(xwidth[k1])) {
+ switch (xdirection) {
+ case 1:
+ /* SWP->SWC: [-bar] to [cm] */
+ xres[k1] = SWRC_SWPtoSWC(
+ xx[k1],
+ xswrc_type[k1],
+ swrcpk,
+ xcoarse[k1],
+ xwidth[k1],
+ LOGWARN
+ );
+ break;
+
+ case 2:
+ /* SWC->SWP: [cm] to [-bar] */
+ xres[k1] = SWRC_SWCtoSWP(
+ xx[k1],
+ xswrc_type[k1],
+ swrcpk,
+ xcoarse[k1],
+ xwidth[k1],
+ LOGWARN
+ );
+ break;
+ }
+
+ // Translate SOILWAT2 missing to R missing value
+ if (EQ(xres[k1], SW_MISSING)) {
+ xres[k1] = NA_REAL;
+ }
+
+ } else {
+ // Input values are not finite
+ xres[k1] = NA_REAL;
+ }
+ }
+
+ UNPROTECT(6);
+
+ return res;
+}
diff --git a/src/SW_R_lib.h b/src/SW_R_lib.h
index c36bfde8..a5f6113f 100644
--- a/src/SW_R_lib.h
+++ b/src/SW_R_lib.h
@@ -7,17 +7,7 @@
#ifndef SW_R_LIB_H_
#define SW_R_LIB_H_
-#include "SOILWAT2/SW_Model.h"
-#include "SOILWAT2/SW_Site.h"
-#include "SOILWAT2/SW_VegEstab.h"
-#include "SOILWAT2/SW_Output.h"
-#include "SOILWAT2/SW_Weather.h"
-#include "SOILWAT2/SW_Sky.h"
-#include "SOILWAT2/SW_VegProd.h"
-#include "SOILWAT2/SW_VegEstab.h"
-#include "SOILWAT2/SW_SoilWater.h"
-#include "SOILWAT2/SW_Markov.h"
-#include "SOILWAT2/SW_Control.h"
+#include "SOILWAT2/include/SW_Control.h"
#include
#include
@@ -38,9 +28,37 @@ extern Bool bWeatherList;
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
+SEXP sw_quiet(SEXP quiet);
SEXP tempError(void);
-SEXP onGetInputDataFromFiles(SEXP input);
+SEXP onGetInputDataFromFiles(SEXP input, SEXP quiet);
SEXP start(SEXP inputOptions, SEXP inputData, SEXP weatherList, SEXP quiet);
+SEXP rSW2_processAllWeather(SEXP weatherList, SEXP inputData);
+SEXP rSW2_readAllWeatherFromDisk(
+ SEXP path,
+ SEXP name_prefix,
+ SEXP startYear,
+ SEXP endYear,
+ SEXP dailyInputFlags
+);
SEXP sw_consts(void);
+SEXP rSW2_SWRC_PTF_estimate_parameters(
+ SEXP ptf_type,
+ SEXP sand,
+ SEXP clay,
+ SEXP gravel,
+ SEXP bdensity
+);
+
+SEXP sw_check_SWRC_vs_PTF(SEXP swrc_type, SEXP swrcp);
+
+SEXP rSW2_SWRC(
+ SEXP x,
+ SEXP direction,
+ SEXP swrc_type,
+ SEXP swrcp,
+ SEXP gravel,
+ SEXP width
+);
+
#endif /* SW_R_LIB_H_ */
diff --git a/src/rSW_Carbon.c b/src/rSW_Carbon.c
index a629fd29..76e3bdbd 100644
--- a/src/rSW_Carbon.c
+++ b/src/rSW_Carbon.c
@@ -16,12 +16,12 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Model.h" // externs `SW_Model`
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Model.h" // externs `SW_Model`
-#include "SOILWAT2/SW_Carbon.h" // externs `SW_Carbon`
+#include "SOILWAT2/include/SW_Carbon.h" // externs `SW_Carbon`
#include "rSW_Carbon.h"
#include
diff --git a/src/rSW_Control.c b/src/rSW_Control.c
index e7cd57f4..3086dbf0 100644
--- a/src/rSW_Control.c
+++ b/src/rSW_Control.c
@@ -16,9 +16,9 @@
/* INCLUDES / DEFINES */
/* --------------------------------------------------- */
-#include "SOILWAT2/generic.h" // for `swprintf`
-#include "SOILWAT2/SW_Carbon.h" // for `calculate_CO2_multipliers`
-#include "SOILWAT2/SW_Control.h" // for `SW_CTL_read_inputs_from_disk`
+#include "SOILWAT2/include/generic.h" // for `swprintf`
+#include "SOILWAT2/include/SW_Carbon.h" // for `calculate_CO2_multipliers`
+#include "SOILWAT2/include/SW_Control.h" // for `SW_CTL_read_inputs_from_disk`
#include "rSW_Files.h"
#include "rSW_Model.h"
@@ -63,8 +63,12 @@ void rSW_CTL_obtain_inputs(Bool from_files) {
} else { //Use R data to set the data
#ifdef RSWDEBUG
- if (debug) swprintf("'rSW_CTL_obtain_inputs': Copy data from rSOILWAT2 S4 "
- "'InputData' object to SOILWAT2 variables:");
+ if (debug) {
+ swprintf(
+ "\n'rSW_CTL_obtain_inputs()': "
+ "Copy data from rSOILWAT2 S4 'InputData' object to SOILWAT2 variables:"
+ );
+ }
#endif
onSet_SW_F(GET_SLOT(InputData, install("files")));
@@ -77,7 +81,7 @@ void rSW_CTL_obtain_inputs(Bool from_files) {
if (debug) swprintf(" > 'model'");
#endif
- onSet_SW_WTH(GET_SLOT(InputData, install("weather")));
+ onSet_SW_WTH_setup(GET_SLOT(InputData, install("weather")));
#ifdef RSWDEBUG
if (debug) swprintf(" > 'weather-setup'");
#endif
@@ -92,10 +96,15 @@ void rSW_CTL_obtain_inputs(Bool from_files) {
) {
onSet_MKV(GET_SLOT(InputData, install("markov")));
#ifdef RSWDEBUG
- if (debug) swprintf(" > 'mwgen'");
+ if (debug) swprintf(" > 'weather generator'");
#endif
}
+ onSet_WTH_DATA();
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > 'weather-history'");
+ #endif
+
onSet_SW_VPD(GET_SLOT(InputData, install("prod")));
#ifdef RSWDEBUG
if (debug) swprintf(" > 'veg'");
@@ -106,9 +115,9 @@ void rSW_CTL_obtain_inputs(Bool from_files) {
if (debug) swprintf(" > 'site'");
#endif
- onSet_SW_LYR(GET_SLOT(InputData, install("soils")));
+ onSet_SW_SOILS(GET_SLOT(InputData, install("soils")));
#ifdef RSWDEBUG
- if (debug) swprintf(" > 'soils'");
+ if (debug) swprintf(" > 'soils' + 'swrc parameters'");
#endif
onSet_SW_VES(GET_SLOT(InputData, install("estab")));
diff --git a/src/rSW_Files.c b/src/rSW_Files.c
index cae9849e..315f6214 100644
--- a/src/rSW_Files.c
+++ b/src/rSW_Files.c
@@ -17,13 +17,13 @@
#include // for `FILENAME_MAX`
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/myMemory.h"
+#include "SOILWAT2/include/SW_Defines.h"
// externs `*InFiles`, `_ProjDir`, `weather_prefix`, `output_prefix`
-#include "SOILWAT2/SW_Files.h"
+#include "SOILWAT2/include/SW_Files.h"
#include "rSW_Files.h"
#include
@@ -35,7 +35,7 @@
/* Global Function Definitions */
/* --------------------------------------------------- */
-SEXP onGet_SW_F() {
+SEXP onGet_SW_F(void) {
int i = 0;
SEXP swFiles;
diff --git a/src/rSW_Files.h b/src/rSW_Files.h
index a1bd21a6..b96655bc 100644
--- a/src/rSW_Files.h
+++ b/src/rSW_Files.h
@@ -4,5 +4,5 @@
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_F();
+SEXP onGet_SW_F(void);
void onSet_SW_F(SEXP SW_F_construct);
diff --git a/src/rSW_Markov.c b/src/rSW_Markov.c
index 7e667670..323759c0 100644
--- a/src/rSW_Markov.c
+++ b/src/rSW_Markov.c
@@ -19,12 +19,13 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Markov.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Weather.h"
+#include "SOILWAT2/include/SW_Markov.h"
#include "rSW_Markov.h" // externs `SW_Markov`
@@ -67,14 +68,22 @@ void onSet_MKV(SEXP MKV) {
PROTECT(MKV_prob = GET_SLOT(MKV, install(cSW_MKV[0])));
PROTECT(MKV_conv = GET_SLOT(MKV, install(cSW_MKV[1])));
- if (!onSet_MKV_prob(MKV_prob)) {
- LogError(logfp, LOGFATAL, "Markov weather generator: rSOILWAT2 failed to "
- "pass `MKV_prob` values to SOILWAT2.\n");
+ if (!onSet_MKV_prob(MKV_prob) && SW_Weather.generateWeatherMethod == 2) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "Markov weather generator: "
+ "rSOILWAT2 failed to pass `MKV_prob` values to SOILWAT2.\n"
+ );
}
- if (!onSet_MKV_conv(MKV_conv)) {
- LogError(logfp, LOGFATAL, "Markov weather generator: rSOILWAT2 failed to "
- "pass `MKV_conv` values to SOILWAT2.\n");
+ if (!onSet_MKV_conv(MKV_conv) && SW_Weather.generateWeatherMethod == 2) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "Markov weather generator: "
+ "rSOILWAT2 failed to pass `MKV_conv` values to SOILWAT2.\n"
+ );
}
UNPROTECT(2);
diff --git a/src/rSW_Model.c b/src/rSW_Model.c
index ac2064a3..daf18727 100644
--- a/src/rSW_Model.c
+++ b/src/rSW_Model.c
@@ -22,14 +22,14 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Times.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Model.h" // externs `SW_Model`
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Times.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Model.h" // externs `SW_Model`
#include "rSW_Model.h"
@@ -49,7 +49,7 @@ static char *MyFileName;
/* Global Function Definitions */
/* --------------------------------------------------- */
-SEXP onGet_SW_MDL() {
+SEXP onGet_SW_MDL(void) {
SW_MODEL *m = &SW_Model;
SEXP swYears;
@@ -140,7 +140,7 @@ void onSet_SW_MDL(SEXP SW_MDL) {
fhemi = TRUE;
if (!(fstartdy && fenddy && fhemi)) {
- sprintf(errstr, "\nNot found in %s:\n", MyFileName);
+ snprintf(errstr, MAX_ERROR, "\nNot found in %s:\n", MyFileName);
if (!fstartdy) {
strcat(errstr, "\tStart Day - using 1\n");
m->startstart = 1;
diff --git a/src/rSW_Model.h b/src/rSW_Model.h
index 09453e48..0ed76d39 100644
--- a/src/rSW_Model.h
+++ b/src/rSW_Model.h
@@ -3,5 +3,5 @@
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_MDL();
+SEXP onGet_SW_MDL(void);
void onSet_SW_MDL(SEXP SW_MDL);
diff --git a/src/rSW_Output.c b/src/rSW_Output.c
index 81b04948..30858696 100644
--- a/src/rSW_Output.c
+++ b/src/rSW_Output.c
@@ -19,17 +19,17 @@
#include
#include
-#include "SOILWAT2/generic.h" // externs `EchoInits`
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
+#include "SOILWAT2/include/generic.h" // externs `EchoInits`
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Site.h" // externs `SW_Site`
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Site.h" // externs `SW_Site`
-#include "SOILWAT2/SW_Output.h" // externs many variables
-#include "SOILWAT2/SW_Output_outarray.h" // for function `SW_OUT_set_nrow`
+#include "SOILWAT2/include/SW_Output.h" // externs many variables
+#include "SOILWAT2/include/SW_Output_outarray.h" // for function `SW_OUT_set_nrow`
#include "rSW_Output.h"
#include
@@ -56,9 +56,9 @@ void onSet_SW_OUT(SEXP OUT) {
int i, msg_type;
OutKey k;
SEXP sep, outfile, tp_convert;
- int *use, *timePeriods, *sumtype, *first_orig, *last_orig;
- // mykey and myobj are currently unused:
- // int *mykey, *myobj;
+ int *timePeriods, *sumtype, *first_orig, *last_orig;
+ // mykey, myobj and use are currently unused:
+ // int *use, *mykey, *myobj;
char msg[200]; // message to print
#ifdef RSWDEBUG
int debug = 0;
@@ -78,11 +78,11 @@ void onSet_SW_OUT(SEXP OUT) {
timePeriods = INTEGER(tp_convert);
used_OUTNPERIODS = INTEGER(GET_DIM(GET_SLOT(OUT, install("timeSteps"))))[1]; // number of columns
- // mykey and myobj are currently unused:
+ // mykey, myobj and use are currently unused:
// mykey = INTEGER(GET_SLOT(OUT, install("mykey")));
// myobj = INTEGER(GET_SLOT(OUT, install("myobj")));
+ // use = LOGICAL(GET_SLOT(OUT, install("use")));
sumtype = INTEGER(GET_SLOT(OUT, install("sumtype")));
- use = LOGICAL(GET_SLOT(OUT, install("use")));
first_orig = INTEGER(GET_SLOT(OUT, install("first_orig")));
last_orig = INTEGER(GET_SLOT(OUT, install("last_orig")));
PROTECT(outfile = GET_SLOT(OUT, install("outfile")));
@@ -93,7 +93,8 @@ void onSet_SW_OUT(SEXP OUT) {
sumtype[k],
first_orig[k],
last_orig[k],
- msg
+ msg,
+ sizeof msg
);
if (msg_type > 0) {
diff --git a/src/rSW_Site.c b/src/rSW_Site.c
index 07e93fb7..ff5b3ce2 100644
--- a/src/rSW_Site.c
+++ b/src/rSW_Site.c
@@ -19,17 +19,17 @@
#include
#include
-#include "SOILWAT2/generic.h" // externs `EchoInits`
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
+#include "SOILWAT2/include/generic.h" // externs `EchoInits`
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_SoilWater.h"
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_SoilWater.h"
// externs `SW_Site`, `_TranspRgnBounds`, _SWCInitVal, _SWCWetVal, _SWCMinVal
-#include "SOILWAT2/SW_Site.h"
+#include "SOILWAT2/include/SW_Site.h"
#include "rSW_Site.h"
#include
@@ -49,7 +49,10 @@ static char *cSW_SIT[] = {
"SWClimits", "ModelFlags", "ModelCoefficients",
"SnowSimulationParameters", "DrainageCoefficient", "EvaporationCoefficients",
"TranspirationCoefficients", "IntrinsicSiteParams", "SoilTemperatureFlag",
- "SoilTemperatureConstants", "TranspirationRegions"
+ "SoilTemperatureConstants",
+ "SoilDensityInputType",
+ "TranspirationRegions",
+ "swrc_flags", "has_swrcp"
};
static char *cLayers[] = {
@@ -58,25 +61,27 @@ static char *cLayers[] = {
"transpForb_frac", "sand_frac", "clay_frac", "impermeability_frac", "soilTemp_c"
};
+static char *cSWRCp[] = {
+ "Param1", "Param2", "Param3", "Param4", "Param5", "Param6"
+};
+
/* =================================================== */
-/* Global Function Definitions */
+/* Local Function Definitions */
/* --------------------------------------------------- */
-SEXP onGet_SW_LYR() {
+/* Copy soil properties into "Layers" matrix */
+static SEXP onGet_SW_LYR(void) {
int i, dmax = 0;
SW_SITE *v = &SW_Site;
- SEXP swSoils, SW_SOILS;
- SEXP Layers,Layers_names,Layers_names_y;
+ SEXP Layers, Layers_names, Layers_names_y;
RealD *p_Layers;
- PROTECT(swSoils = MAKE_CLASS("swSoils"));
- PROTECT(SW_SOILS = NEW_OBJECT(swSoils));
- PROTECT(Layers = allocMatrix(REALSXP,v->n_layers,12));
+ PROTECT(Layers = allocMatrix(REALSXP, v->n_layers, 12));
p_Layers = REAL(Layers);
for (i = 0; i < (v->n_layers); i++) {
p_Layers[i + (v->n_layers) * 0] = dmax = v->lyr[i]->width + dmax;
- p_Layers[i + (v->n_layers) * 1] = v->lyr[i]->soilMatric_density;
+ p_Layers[i + (v->n_layers) * 1] = v->lyr[i]->soilDensityInput;
p_Layers[i + (v->n_layers) * 2] = v->lyr[i]->fractionVolBulk_gravel;
p_Layers[i + (v->n_layers) * 3] = v->lyr[i]->evap_coeff;
p_Layers[i + (v->n_layers) * 4] = v->lyr[i]->transp_coeff[SW_GRASS];
@@ -88,34 +93,33 @@ SEXP onGet_SW_LYR() {
p_Layers[i + (v->n_layers) * 10] = v->lyr[i]->impermeability;
p_Layers[i + (v->n_layers) * 11] = v->lyr[i]->avgLyrTemp;
}
- PROTECT(Layers_names = allocVector(VECSXP,2));
- PROTECT(Layers_names_y = allocVector(STRSXP,12));
- for(i=0;i<12;i++)
- SET_STRING_ELT(Layers_names_y,i,mkChar(cLayers[i]));
- SET_VECTOR_ELT(Layers_names,1,Layers_names_y);
- setAttrib(Layers, R_DimNamesSymbol, Layers_names);
- SET_SLOT(SW_SOILS,install("Layers"),Layers);
+ PROTECT(Layers_names = allocVector(VECSXP, 2));
+ PROTECT(Layers_names_y = allocVector(STRSXP, 12));
+ for (i = 0; i < 12; i++) {
+ SET_STRING_ELT(Layers_names_y, i, mkChar(cLayers[i]));
+ }
+ SET_VECTOR_ELT(Layers_names, 1, Layers_names_y);
+ setAttrib(Layers, R_DimNamesSymbol, Layers_names);
- UNPROTECT(5);
- return SW_SOILS;
+ UNPROTECT(3);
+ return Layers;
}
-/* Function `onSet_SW_LYR()` corresponds to SOILWAT2's `_read_layers()` */
-void onSet_SW_LYR(SEXP SW_SOILS) {
+/* Function `onSet_SW_LYR()` corresponds to SOILWAT2's `SW_LYR_read()`,
+ previously named `_read_layers()`
+*/
+static void onSet_SW_LYR(SEXP SW_LYR) {
SW_SITE *v = &SW_Site;
LyrIndex lyrno;
int i, j, k, columns;
- RealF dmin = 0.0, dmax, evco, trco_veg[NVEGTYPES], psand, pclay, matricd, imperm, soiltemp, f_gravel;
+ RealF dmin = 0.0, dmax, evco, trco_veg[NVEGTYPES], psand, pclay, soildensity, imperm, soiltemp, f_gravel;
RealD *p_Layers;
- SEXP SW_LYR;
/* note that Files.read() must be called prior to this. */
- PROTECT(SW_LYR = GET_SLOT(SW_SOILS,install("Layers")));
MyFileName = SW_F_name(eLayers);
-
j = nrows(SW_LYR);
p_Layers = REAL(SW_LYR);
columns = ncols(SW_LYR);
@@ -135,7 +139,7 @@ void onSet_SW_LYR(SEXP SW_SOILS) {
lyrno = _newlayer();
dmax = p_Layers[i + j * 0];
- matricd = p_Layers[i + j * 1];
+ soildensity = p_Layers[i + j * 1];
f_gravel = p_Layers[i + j * 2];
evco = p_Layers[i + j * 3];
trco_veg[SW_GRASS] = p_Layers[i + j * 4];
@@ -149,7 +153,7 @@ void onSet_SW_LYR(SEXP SW_SOILS) {
v->lyr[lyrno]->width = dmax - dmin;
dmin = dmax;
- v->lyr[lyrno]->soilMatric_density = matricd;
+ v->lyr[lyrno]->soilDensityInput = soildensity;
v->lyr[lyrno]->fractionVolBulk_gravel = f_gravel;
v->lyr[lyrno]->evap_coeff = evco;
ForEachVegType(k) {
@@ -169,13 +173,112 @@ void onSet_SW_LYR(SEXP SW_SOILS) {
MyFileName, lyrno + 1, MAX_LAYERS
);
}
+ }
+}
+
+
+/* Copy SWRC parameters into "SWRCp" matrix */
+static SEXP onGet_SW_SWRCp(void) {
+ int i, k;
+ SW_SITE *v = &SW_Site;
+ SEXP SWRCp, SWRCp_names, SWRCp_names_y;
+ RealD *p_SWRCp;
+ PROTECT(SWRCp = allocMatrix(REALSXP, v->n_layers, SWRC_PARAM_NMAX));
+ p_SWRCp = REAL(SWRCp);
+ for (i = 0; i < (v->n_layers); i++) {
+ for (k = 0; k < SWRC_PARAM_NMAX; k++) {
+ p_SWRCp[i + (v->n_layers) * k] = v->lyr[i]->swrcp[k];
+ }
}
- UNPROTECT(1);
+ PROTECT(SWRCp_names = allocVector(VECSXP, 2));
+ PROTECT(SWRCp_names_y = allocVector(STRSXP, SWRC_PARAM_NMAX));
+ for (i = 0; i < SWRC_PARAM_NMAX; i++) {
+ SET_STRING_ELT(SWRCp_names_y, i, mkChar(cSWRCp[i]));
+ }
+ SET_VECTOR_ELT(SWRCp_names, 1, SWRCp_names_y);
+ setAttrib(SWRCp, R_DimNamesSymbol, SWRCp_names);
+
+ UNPROTECT(3);
+ return SWRCp;
}
-SEXP onGet_SW_SIT() {
+/* Function `onSet_SW_SWRCp()` corresponds to SOILWAT2's `SW_SWRC_read()` */
+static void onSet_SW_SWRCp(SEXP SW_SWRCp) {
+
+ SW_SITE *v = &SW_Site;
+ int i, k;
+ RealD *p_SWRCp;
+
+ /* note that Files.read() must be called prior to this. */
+ MyFileName = SW_F_name(eSWRCp);
+
+ /* Check that we have n = `SWRC_PARAM_NMAX` values per layer */
+ if (ncols(SW_SWRCp) != SWRC_PARAM_NMAX) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "%s : Bad number of SWRC parameters %d -- must be %d.\n",
+ MyFileName, ncols(SW_SWRCp), SWRC_PARAM_NMAX
+ );
+ }
+
+ /* Check that we have `SW_Site.n_layers` */
+ if (nrows(SW_SWRCp) != SW_Site.n_layers) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "%s : Number of layers with SWRC parameters (%d) "
+ "must match number of soil layers (%d)\n",
+ MyFileName, nrows(SW_SWRCp), SW_Site.n_layers
+ );
+ }
+
+ /* Copy values */
+ p_SWRCp = REAL(SW_SWRCp);
+
+ for (i = 0; i < (v->n_layers); i++) {
+ for (k = 0; k < SWRC_PARAM_NMAX; k++) {
+ v->lyr[i]->swrcp[k] = p_SWRCp[i + (v->n_layers) * k];
+ }
+ }
+}
+
+
+/* =================================================== */
+/* Global Function Definitions */
+/* --------------------------------------------------- */
+
+/* Copy SOILWAT2 soil properties and SWRC parameters into S4 class "swSoils" */
+SEXP onGet_SW_SOILS(void) {
+ SEXP swSoils, SW_SOILS;
+
+ PROTECT(swSoils = MAKE_CLASS("swSoils"));
+ PROTECT(SW_SOILS = NEW_OBJECT(swSoils));
+
+ SET_SLOT(SW_SOILS, install("Layers"), onGet_SW_LYR());
+ SET_SLOT(SW_SOILS, install("SWRCp"), onGet_SW_SWRCp());
+
+ UNPROTECT(2);
+ return SW_SOILS;
+}
+
+/* Copy S4 class "swSoils" into SOILWAT2 soil properties and SWRC parameters */
+void onSet_SW_SOILS(SEXP SW_SOILS) {
+ SEXP SW_LYR, SW_SWRCp;
+
+ PROTECT(SW_LYR = GET_SLOT(SW_SOILS, install("Layers")));
+ onSet_SW_LYR(SW_LYR);
+
+ PROTECT(SW_SWRCp = GET_SLOT(SW_SOILS, install("SWRCp")));
+ onSet_SW_SWRCp(SW_SWRCp);
+
+ UNPROTECT(2);
+}
+
+
+SEXP onGet_SW_SIT(void) {
int i;
SW_SITE *v = &SW_Site;
@@ -204,8 +307,21 @@ SEXP onGet_SW_SIT() {
char *cIntrinsicSiteParams[] = { "Longitude", "Latitude", "Altitude", "Slope", "Aspect" };
SEXP SoilTemperatureConstants_use, SoilTemperatureConstants, SoilTemperatureConstants_names;
- char *cSoilTempValues[] = { "BiomassLimiter_g/m^2", "T1constant_a", "T1constant_b", "T1constant_c", "cs_constant_SoilThermCondct", "cs_constant", "sh_constant_SpecificHeatCapacity",
- "ConstMeanAirTemp", "deltaX_Param", "MaxDepth" };
+ char *cSoilTempValues[] = {
+ "BiomassLimiter_g/m^2",
+ "T1constant_a", "T1constant_b", "T1constant_c",
+ "cs_constant_SoilThermCondct", "cs_constant",
+ "sh_constant_SpecificHeatCapacity",
+ "ConstMeanAirTemp",
+ "deltaX_Param", "MaxDepth"
+ };
+
+ SEXP swrc_flags, swrc_names;
+ char *cSWRCflags[] = {"swrc_name", "ptf_name"};
+
+ SEXP has_swrcp;
+
+ SEXP SoilDensityInputType;
SEXP TranspirationRegions, TranspirationRegions_names, TranspirationRegions_names_y;
char *cTranspirationRegions[] = { "ndx", "layer" };
@@ -310,6 +426,8 @@ SEXP onGet_SW_SIT() {
SET_STRING_ELT(SoilTemperatureConstants_names, i, mkChar(cSoilTempValues[i]));
setAttrib(SoilTemperatureConstants, R_NamesSymbol, SoilTemperatureConstants_names);
+ PROTECT(SoilDensityInputType = ScalarInteger(v->type_soilDensityInput));
+
PROTECT(TranspirationRegions = allocMatrix(INTSXP,(v->n_transp_rgn),2));
p_transp = INTEGER(TranspirationRegions);
for (i = 0; i < (v->n_transp_rgn); i++) {
@@ -323,6 +441,22 @@ SEXP onGet_SW_SIT() {
SET_VECTOR_ELT(TranspirationRegions_names, 1, TranspirationRegions_names_y);
setAttrib(TranspirationRegions, R_DimNamesSymbol, TranspirationRegions_names);
+
+ PROTECT(swrc_flags = NEW_CHARACTER(2));
+ SET_STRING_ELT(swrc_flags, 0, mkChar(v->site_swrc_name));
+ SET_STRING_ELT(swrc_flags, 1, mkChar(v->site_ptf_name));
+
+ PROTECT(swrc_names = NEW_CHARACTER(2));
+ for (i = 0; i < 2; i++) {
+ SET_STRING_ELT(swrc_names, i, mkChar(cSWRCflags[i]));
+ }
+ setAttrib(swrc_flags, R_NamesSymbol, swrc_names);
+
+ PROTECT(has_swrcp = NEW_LOGICAL(1));
+ LOGICAL(has_swrcp)[0] = v->site_has_swrcp;
+
+
+ // Fill all slots of `SW_SIT`
SET_SLOT(SW_SIT, install(cSW_SIT[0]), SWClimits);
SET_SLOT(SW_SIT, install(cSW_SIT[1]), ModelFlags);
SET_SLOT(SW_SIT, install(cSW_SIT[2]), ModelCoefficients);
@@ -333,9 +467,12 @@ SEXP onGet_SW_SIT() {
SET_SLOT(SW_SIT, install(cSW_SIT[7]), IntrinsicSiteParams);
SET_SLOT(SW_SIT, install(cSW_SIT[8]), SoilTemperatureConstants_use);
SET_SLOT(SW_SIT, install(cSW_SIT[9]), SoilTemperatureConstants);
- SET_SLOT(SW_SIT, install(cSW_SIT[10]), TranspirationRegions);
+ SET_SLOT(SW_SIT, install(cSW_SIT[10]), SoilDensityInputType);
+ SET_SLOT(SW_SIT, install(cSW_SIT[11]), TranspirationRegions);
+ SET_SLOT(SW_SIT, install(cSW_SIT[12]), swrc_flags);
+ SET_SLOT(SW_SIT, install(cSW_SIT[13]), has_swrcp);
- UNPROTECT(24);
+ UNPROTECT(28);
return SW_SIT;
}
@@ -353,7 +490,10 @@ void onSet_SW_SIT(SEXP SW_SIT) {
SEXP IntrinsicSiteParams;
SEXP SoilTemperatureConstants_use;
SEXP SoilTemperatureConstants;
+ SEXP SoilDensityInputType;
SEXP TranspirationRegions;
+ SEXP swrc_flags, has_swrcp;
+
int *p_transp; // ideally `LyrIndex` so that same type as `_TranspRgnBounds`, but R API INTEGER() is signed
#ifdef RSWDEBUG
@@ -459,6 +599,26 @@ void onSet_SW_SIT(SEXP SW_SIT) {
if (debug) swprintf(" > 'soiltemp-constants'");
#endif
+ PROTECT(SoilDensityInputType = GET_SLOT(SW_SIT, install("SoilDensityInputType")));
+ v->type_soilDensityInput = INTEGER(SoilDensityInputType)[0];
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > 'density-type'");
+ #endif
+
+
+ PROTECT(swrc_flags = GET_SLOT(SW_SIT, install("swrc_flags")));
+ strcpy(v->site_swrc_name, CHAR(STRING_ELT(swrc_flags, 0)));
+ v->site_swrc_type = encode_str2swrc(v->site_swrc_name);
+ strcpy(v->site_ptf_name, CHAR(STRING_ELT(swrc_flags, 1)));
+ v->site_ptf_type = encode_str2ptf(v->site_ptf_name);
+ PROTECT(has_swrcp = GET_SLOT(SW_SIT, install("has_swrcp")));
+ v->site_has_swrcp = LOGICAL(has_swrcp)[0];
+
+ #ifdef RSWDEBUG
+ if (debug) swprintf(" > 'swrc/ptf-type'");
+ #endif
+
+
PROTECT(TranspirationRegions = GET_SLOT(SW_SIT, install("TranspirationRegions")));
p_transp = INTEGER(TranspirationRegions);
v->n_transp_rgn = nrows(TranspirationRegions);
@@ -488,5 +648,5 @@ void onSet_SW_SIT(SEXP SW_SIT) {
if (debug) swprintf(" ... done. \n");
#endif
- UNPROTECT(11);
+ UNPROTECT(14);
}
diff --git a/src/rSW_Site.h b/src/rSW_Site.h
index 51daa77b..65a3b3d0 100644
--- a/src/rSW_Site.h
+++ b/src/rSW_Site.h
@@ -3,7 +3,7 @@
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_SIT();
+SEXP onGet_SW_SIT(void);
void onSet_SW_SIT(SEXP SW_SIT);
-SEXP onGet_SW_LYR();
-void onSet_SW_LYR(SEXP SW_SOILS);
+SEXP onGet_SW_SOILS(void);
+void onSet_SW_SOILS(SEXP SW_SOILS);
diff --git a/src/rSW_Sky.c b/src/rSW_Sky.c
index 4db4ba93..9b9e7303 100644
--- a/src/rSW_Sky.c
+++ b/src/rSW_Sky.c
@@ -16,14 +16,14 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
-#include "SOILWAT2/SW_Weather.h" // externs `SW_Weather`
-#include "SOILWAT2/SW_Sky.h" // externs `SW_Sky`
+#include "SOILWAT2/include/SW_Weather.h" // externs `SW_Weather`
+#include "SOILWAT2/include/SW_Sky.h" // externs `SW_Sky`
#include "rSW_Sky.h"
#include
@@ -41,7 +41,7 @@ static char *MyFileName;
/* Global Function Definitions */
/* --------------------------------------------------- */
-SEXP onGet_SW_SKY() {
+SEXP onGet_SW_SKY(void) {
int i;
SW_SKY *v = &SW_Sky;
diff --git a/src/rSW_Sky.h b/src/rSW_Sky.h
index b6e8e833..896c9157 100644
--- a/src/rSW_Sky.h
+++ b/src/rSW_Sky.h
@@ -3,5 +3,5 @@
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_SKY();
+SEXP onGet_SW_SKY(void);
void onSet_SW_SKY(SEXP SW_SKY);
diff --git a/src/rSW_SoilWater.c b/src/rSW_SoilWater.c
index 5d264c2f..39d95bde 100644
--- a/src/rSW_SoilWater.c
+++ b/src/rSW_SoilWater.c
@@ -21,17 +21,17 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Model.h" // externs `SW_Model`
-#include "SOILWAT2/SW_Site.h" // externs `SW_Site`
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Model.h" // externs `SW_Model`
+#include "SOILWAT2/include/SW_Site.h" // externs `SW_Site`
-#include "SOILWAT2/SW_SoilWater.h" // externs `SW_Soilwat`
+#include "SOILWAT2/include/SW_SoilWater.h" // externs `SW_Soilwat`
#include "rSW_SoilWater.h"
#include "SW_R_lib.h" // externs `InputData`
@@ -57,7 +57,7 @@ void rSW_SWC_construct(void) {
}
-SEXP onGet_SW_SWC() {
+SEXP onGet_SW_SWC(void) {
SW_SOILWAT *v = &SW_Soilwat;
SEXP swSWC;
SEXP SWC;
@@ -129,7 +129,7 @@ void onSet_SW_SWC(SEXP SWC) {
}
-SEXP onGet_SW_SWC_hists() {
+SEXP onGet_SW_SWC_hists(void) {
TimeInt year;
SEXP SWC_hists, SWC_hists_names;
int years = ((SW_Model.endyr + 1) - SW_Model.startyr), i = 0;
@@ -142,7 +142,7 @@ SEXP onGet_SW_SWC_hists() {
if (SW_Soilwat.hist_use && year >= SW_Soilwat.hist.yr.first) {
_read_swc_hist(year);
SET_VECTOR_ELT(SWC_hists, i, onGet_SW_SWC_hist(year));
- sprintf(cYear, "%4d", year);
+ snprintf(cYear, sizeof cYear, "%4d", year);
SET_STRING_ELT(SWC_hists_names, i, mkChar(cYear));
}
i++;
diff --git a/src/rSW_SoilWater.h b/src/rSW_SoilWater.h
index f1d6226c..926361ee 100644
--- a/src/rSW_SoilWater.h
+++ b/src/rSW_SoilWater.h
@@ -1,4 +1,4 @@
-#include "SOILWAT2/Times.h"
+#include "SOILWAT2/include/Times.h"
#include // for SEXP
/* =================================================== */
diff --git a/src/rSW_VegEstab.c b/src/rSW_VegEstab.c
index d096e7db..0d64b165 100644
--- a/src/rSW_VegEstab.c
+++ b/src/rSW_VegEstab.c
@@ -16,15 +16,15 @@
#include
#include
-#include "SOILWAT2/generic.h" // externs `EchoInits`
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
+#include "SOILWAT2/include/generic.h" // externs `EchoInits`
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
-#include "SOILWAT2/SW_VegEstab.h" // externs `SW_VegEstab`
+#include "SOILWAT2/include/SW_VegEstab.h" // externs `SW_VegEstab`
#include "rSW_VegEstab.h"
#include
diff --git a/src/rSW_VegEstab.h b/src/rSW_VegEstab.h
index 0fd9f6cf..189fc09f 100644
--- a/src/rSW_VegEstab.h
+++ b/src/rSW_VegEstab.h
@@ -1,5 +1,5 @@
-#include "SOILWAT2/generic.h"
+#include "SOILWAT2/include/generic.h"
#include // for SEXP
/* =================================================== */
diff --git a/src/rSW_VegProd.c b/src/rSW_VegProd.c
index d97943be..580e0dbd 100644
--- a/src/rSW_VegProd.c
+++ b/src/rSW_VegProd.c
@@ -18,15 +18,15 @@ vegetation production parameter information.
#include
#include
-#include "SOILWAT2/generic.h" // externs `EchoInits`
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
+#include "SOILWAT2/include/generic.h" // externs `EchoInits`
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
-#include "SOILWAT2/SW_VegProd.h" // externs `SW_VegProd`
+#include "SOILWAT2/include/SW_VegProd.h" // externs `SW_VegProd`
#include "rSW_VegProd.h"
#include
@@ -42,7 +42,7 @@ static char *MyFileName;
static char *cVegProd_names[] = {
- "Composition", "Albedo", "CanopyHeight",
+ "veg_method", "Composition", "Albedo", "CanopyHeight",
"VegetationInterceptionParameters", "LitterInterceptionParameters",
"EsTpartitioning_param", "Es_param_limit", "Shade", "HydraulicRedistribution_use",
"HydraulicRedistribution", "CriticalSoilWaterPotential", "MonthlyVeg",
@@ -59,14 +59,14 @@ char *cMonths[] = {
/* Global Function Definitions */
/* --------------------------------------------------- */
-SEXP onGet_SW_VPD() {
+SEXP onGet_SW_VPD(void) {
int i;
SW_VEGPROD *v = &SW_VegProd;
SEXP swProd;
SEXP VegProd;
SEXP VegComp, VegComp_names, vegtype_names, col_names;
- SEXP Albedo;
+ SEXP Albedo, veg_method;
SEXP Canopy, Canopy_names, Canopy_names_x;
char *cCanopy_names_x[] = { "xinflec", "yinflec", "range", "slope", "height_cm" };
@@ -149,6 +149,9 @@ SEXP onGet_SW_VPD() {
PROTECT(swProd = MAKE_CLASS("swProd"));
PROTECT(VegProd = NEW_OBJECT(swProd));
+ PROTECT(veg_method = NEW_INTEGER(1));
+ INTEGER(veg_method)[0] = v->veg_method;
+
PROTECT(VegComp = allocVector(REALSXP, NVEGTYPES + 1));
REAL(VegComp)[0] = v->veg[SW_GRASS].cov.fCover; //Grass
REAL(VegComp)[1] = v->veg[SW_SHRUB].cov.fCover; //Shrub
@@ -391,21 +394,22 @@ SEXP onGet_SW_VPD() {
SET_STRING_ELT(col_names, 3, mkChar("Grasses"));
setAttrib(MonthlyVeg, R_NamesSymbol, col_names);
- SET_SLOT(VegProd, install(cVegProd_names[0]), VegComp);
- SET_SLOT(VegProd, install(cVegProd_names[1]), Albedo);
- SET_SLOT(VegProd, install(cVegProd_names[2]), Canopy);
- SET_SLOT(VegProd, install(cVegProd_names[3]), VegInterception);
- SET_SLOT(VegProd, install(cVegProd_names[4]), LitterInterception);
- SET_SLOT(VegProd, install(cVegProd_names[5]), EsTpartitioning_param);
- SET_SLOT(VegProd, install(cVegProd_names[6]), Es_param_limit);
- SET_SLOT(VegProd, install(cVegProd_names[7]), Shade);
- SET_SLOT(VegProd, install(cVegProd_names[8]), Hydraulic_flag);
- SET_SLOT(VegProd, install(cVegProd_names[9]), Hydraulic);
- SET_SLOT(VegProd, install(cVegProd_names[10]), CSWP);
- SET_SLOT(VegProd, install(cVegProd_names[11]), MonthlyVeg);
- SET_SLOT(VegProd, install(cVegProd_names[12]), CO2Coefficients);
-
- UNPROTECT(40);
+ SET_SLOT(VegProd, install(cVegProd_names[0]), veg_method);
+ SET_SLOT(VegProd, install(cVegProd_names[1]), VegComp);
+ SET_SLOT(VegProd, install(cVegProd_names[2]), Albedo);
+ SET_SLOT(VegProd, install(cVegProd_names[3]), Canopy);
+ SET_SLOT(VegProd, install(cVegProd_names[4]), VegInterception);
+ SET_SLOT(VegProd, install(cVegProd_names[5]), LitterInterception);
+ SET_SLOT(VegProd, install(cVegProd_names[6]), EsTpartitioning_param);
+ SET_SLOT(VegProd, install(cVegProd_names[7]), Es_param_limit);
+ SET_SLOT(VegProd, install(cVegProd_names[8]), Shade);
+ SET_SLOT(VegProd, install(cVegProd_names[9]), Hydraulic_flag);
+ SET_SLOT(VegProd, install(cVegProd_names[10]), Hydraulic);
+ SET_SLOT(VegProd, install(cVegProd_names[11]), CSWP);
+ SET_SLOT(VegProd, install(cVegProd_names[12]), MonthlyVeg);
+ SET_SLOT(VegProd, install(cVegProd_names[13]), CO2Coefficients);
+
+ UNPROTECT(41);
return VegProd;
}
@@ -413,6 +417,7 @@ void onSet_SW_VPD(SEXP SW_VPD) {
int i;
SW_VEGPROD *v = &SW_VegProd;
+ SEXP veg_method;
SEXP VegComp;
SEXP Albedo;
SEXP Canopy;
@@ -434,21 +439,24 @@ void onSet_SW_VPD(SEXP SW_VPD) {
MyFileName = SW_F_name(eVegProd);
- PROTECT(VegComp = GET_SLOT(SW_VPD, install(cVegProd_names[0])));
+ PROTECT(veg_method = GET_SLOT(SW_VPD, install(cVegProd_names[0])));
+ v->veg_method = INTEGER(veg_method)[0];
+
+ PROTECT(VegComp = GET_SLOT(SW_VPD, install(cVegProd_names[1])));
v->veg[SW_GRASS].cov.fCover = REAL(VegComp)[0]; //Grass
v->veg[SW_SHRUB].cov.fCover = REAL(VegComp)[1]; //Shrub
v->veg[SW_TREES].cov.fCover = REAL(VegComp)[2]; //Tree
v->veg[SW_FORBS].cov.fCover = REAL(VegComp)[3]; //Forb
v->bare_cov.fCover = REAL(VegComp)[4]; //Bare Ground
- PROTECT(Albedo = GET_SLOT(SW_VPD, install(cVegProd_names[1])));
+ PROTECT(Albedo = GET_SLOT(SW_VPD, install(cVegProd_names[2])));
v->veg[SW_GRASS].cov.albedo = REAL(Albedo)[0]; //Grass
v->veg[SW_SHRUB].cov.albedo = REAL(Albedo)[1]; //Shrub
v->veg[SW_TREES].cov.albedo = REAL(Albedo)[2]; //Tree
v->veg[SW_FORBS].cov.albedo = REAL(Albedo)[3]; //Forb
v->bare_cov.albedo = REAL(Albedo)[4]; //Bare Ground
- PROTECT(Canopy = GET_SLOT(SW_VPD, install(cVegProd_names[2])));
+ PROTECT(Canopy = GET_SLOT(SW_VPD, install(cVegProd_names[3])));
p_Canopy = REAL(Canopy);
v->veg[SW_GRASS].cnpy.xinflec = p_Canopy[0];
v->veg[SW_GRASS].cnpy.yinflec = p_Canopy[1];
@@ -471,7 +479,7 @@ void onSet_SW_VPD(SEXP SW_VPD) {
v->veg[SW_FORBS].cnpy.slope = p_Canopy[18];
v->veg[SW_FORBS].canopy_height_constant = p_Canopy[19];
- PROTECT(VegInterception = GET_SLOT(SW_VPD, install(cVegProd_names[3])));
+ PROTECT(VegInterception = GET_SLOT(SW_VPD, install(cVegProd_names[4])));
p_VegInterception = REAL(VegInterception);
v->veg[SW_GRASS].veg_kSmax = p_VegInterception[0];
v->veg[SW_GRASS].veg_kdead = p_VegInterception[1];
@@ -482,26 +490,26 @@ void onSet_SW_VPD(SEXP SW_VPD) {
v->veg[SW_FORBS].veg_kSmax = p_VegInterception[6];
v->veg[SW_FORBS].veg_kdead = p_VegInterception[7];
- PROTECT(LitterInterception = GET_SLOT(SW_VPD, install(cVegProd_names[4])));
+ PROTECT(LitterInterception = GET_SLOT(SW_VPD, install(cVegProd_names[5])));
p_LitterInterception = REAL(LitterInterception);
v->veg[SW_GRASS].lit_kSmax = p_LitterInterception[0];
v->veg[SW_SHRUB].lit_kSmax = p_LitterInterception[1];
v->veg[SW_TREES].lit_kSmax = p_LitterInterception[2];
v->veg[SW_FORBS].lit_kSmax = p_LitterInterception[3];
- PROTECT(EsTpartitioning_param = GET_SLOT(SW_VPD, install(cVegProd_names[5])));
+ PROTECT(EsTpartitioning_param = GET_SLOT(SW_VPD, install(cVegProd_names[6])));
v->veg[SW_GRASS].EsTpartitioning_param = REAL(EsTpartitioning_param)[0]; //Grass
v->veg[SW_SHRUB].EsTpartitioning_param = REAL(EsTpartitioning_param)[1]; //Shrub
v->veg[SW_TREES].EsTpartitioning_param = REAL(EsTpartitioning_param)[2]; //Tree
v->veg[SW_FORBS].EsTpartitioning_param = REAL(EsTpartitioning_param)[3]; //Forb
- PROTECT(Es_param_limit = GET_SLOT(SW_VPD, install(cVegProd_names[6])));
+ PROTECT(Es_param_limit = GET_SLOT(SW_VPD, install(cVegProd_names[7])));
v->veg[SW_GRASS].Es_param_limit = REAL(Es_param_limit)[0]; //Grass
v->veg[SW_SHRUB].Es_param_limit = REAL(Es_param_limit)[1]; //Shrub
v->veg[SW_TREES].Es_param_limit = REAL(Es_param_limit)[2]; //Tree
v->veg[SW_FORBS].Es_param_limit = REAL(Es_param_limit)[3]; //Forb
- PROTECT(Shade = GET_SLOT(SW_VPD, install(cVegProd_names[7])));
+ PROTECT(Shade = GET_SLOT(SW_VPD, install(cVegProd_names[8])));
p_Shade = REAL(Shade);
v->veg[SW_GRASS].shade_scale = p_Shade[0];
v->veg[SW_GRASS].shade_deadmax = p_Shade[1];
@@ -528,8 +536,8 @@ void onSet_SW_VPD(SEXP SW_VPD) {
v->veg[SW_FORBS].tr_shade_effects.range = p_Shade[22];
v->veg[SW_FORBS].tr_shade_effects.slope = p_Shade[23];
- PROTECT(Hydraulic_flag = GET_SLOT(SW_VPD, install(cVegProd_names[8])));
- PROTECT(Hydraulic = GET_SLOT(SW_VPD, install(cVegProd_names[9])));
+ PROTECT(Hydraulic_flag = GET_SLOT(SW_VPD, install(cVegProd_names[9])));
+ PROTECT(Hydraulic = GET_SLOT(SW_VPD, install(cVegProd_names[10])));
v->veg[SW_GRASS].flagHydraulicRedistribution = LOGICAL_POINTER(Hydraulic_flag)[0]; //Grass
v->veg[SW_SHRUB].flagHydraulicRedistribution = LOGICAL_POINTER(Hydraulic_flag)[1]; //Shrub
v->veg[SW_TREES].flagHydraulicRedistribution = LOGICAL_POINTER(Hydraulic_flag)[2]; //Tree
@@ -547,7 +555,7 @@ void onSet_SW_VPD(SEXP SW_VPD) {
v->veg[SW_FORBS].swpMatric50 = REAL(Hydraulic)[10]; //Forb
v->veg[SW_FORBS].shapeCond = REAL(Hydraulic)[11]; //Forb
- PROTECT(CSWP = GET_SLOT(SW_VPD, install(cVegProd_names[10])));
+ PROTECT(CSWP = GET_SLOT(SW_VPD, install(cVegProd_names[11])));
v->veg[SW_GRASS].SWPcrit = -10 * REAL(CSWP)[0]; //Grass
v->veg[SW_SHRUB].SWPcrit = -10 * REAL(CSWP)[1]; //Shrub
v->veg[SW_TREES].SWPcrit = -10 * REAL(CSWP)[2]; //Tree
@@ -562,7 +570,7 @@ void onSet_SW_VPD(SEXP SW_VPD) {
get_critical_rank();
- PROTECT(MonthlyVeg = GET_SLOT(SW_VPD, install(cVegProd_names[11])));
+ PROTECT(MonthlyVeg = GET_SLOT(SW_VPD, install(cVegProd_names[12])));
PROTECT(Grasslands = VECTOR_ELT(MonthlyVeg, SW_GRASS));
p_Grasslands = REAL(Grasslands);
for (i = 0; i < 12; i++) {
@@ -596,7 +604,7 @@ void onSet_SW_VPD(SEXP SW_VPD) {
v->veg[SW_FORBS].lai_conv[i] = p_Forb[i + 12 * 3];
}
- PROTECT(CO2Coefficients = GET_SLOT(SW_VPD, install(cVegProd_names[12])));
+ PROTECT(CO2Coefficients = GET_SLOT(SW_VPD, install(cVegProd_names[13])));
v->veg[SW_GRASS].co2_bio_coeff1 = REAL(CO2Coefficients)[0];
v->veg[SW_SHRUB].co2_bio_coeff1 = REAL(CO2Coefficients)[1];
v->veg[SW_TREES].co2_bio_coeff1 = REAL(CO2Coefficients)[2];
@@ -620,5 +628,117 @@ void onSet_SW_VPD(SEXP SW_VPD) {
if (EchoInits)
_echo_VegProd();
- UNPROTECT(17);
+ UNPROTECT(18);
+}
+
+SEXP rSW2_estimate_PotNatVeg_composition(SEXP MAP_mm, SEXP MAT_C, SEXP mean_monthly_ppt_mm,
+ SEXP mean_monthly_Temp_C, SEXP shrub_limit, SEXP SumGrasses_Fraction,
+ SEXP fill_empty_with_BareGround, SEXP warn_extrapolation, SEXP dailyC4vars,
+ SEXP isNorth, SEXP fixBareGround, SEXP Succulents_Fraction, SEXP Annuals_Fraction,
+ SEXP C4_Fraction, SEXP C3_Fraction, SEXP Shrubs_Fraction, SEXP Forbs_Fraction,
+ SEXP Trees_Fraction, SEXP BareGround_Fraction) {
+
+ double RelAbundanceL0[8], RelAbundanceL1[5], grasses[3];
+
+ // "final_" in the beginning meaning it's the final R -> conversion
+ double final_MAP_cm = asReal(MAP_mm) / 10, final_MAT_C = asReal(MAT_C), final_MonPPT_cm[MAX_MONTHS],
+ final_MonTemp_C[MAX_MONTHS], final_shrubLimit = asReal(shrub_limit),
+ final_SumGrassesFraction = asReal(SumGrasses_Fraction), C4Variables[3] = {SW_MISSING, SW_MISSING, SW_MISSING};
+
+ // Following variable names end with "_D" to denote they are of C type double
+ double Succulents_Fraction_D = ISNAN(asReal(Succulents_Fraction)) ? SW_MISSING : asReal(Succulents_Fraction);
+ double Annuals_Fraction_D = ISNAN(asReal(Annuals_Fraction)) ? 0.0 : asReal(Annuals_Fraction);
+ double C4_Fraction_D = ISNAN(asReal(C4_Fraction)) ? SW_MISSING : asReal(C4_Fraction);
+ double C3_Fraction_D = ISNAN(asReal(C3_Fraction)) ? SW_MISSING : asReal(C3_Fraction);
+ double Shrubs_Fraction_D = ISNAN(asReal(Shrubs_Fraction)) ? SW_MISSING : asReal(Shrubs_Fraction);
+ double Forbs_Fraction_D = ISNAN(asReal(Forbs_Fraction)) ? SW_MISSING : asReal(Forbs_Fraction);
+ double Trees_Fraction_D = ISNAN(asReal(Trees_Fraction)) ? 0.0 : asReal(Trees_Fraction);
+ double BareGround_Fraction_D = ISNAN(asReal(BareGround_Fraction)) ? 0.0 : asReal(BareGround_Fraction);
+
+ double inputValues_D[8] = {Succulents_Fraction_D, Forbs_Fraction_D, C3_Fraction_D,
+ C4_Fraction_D, Annuals_Fraction_D, Shrubs_Fraction_D, Trees_Fraction_D, BareGround_Fraction_D};
+
+ char *RelAbundanceL0Names[] = {"Succulents", "Forbs", "Grasses_C3", "Grasses_C4",
+ "Grasses_Annuals", "Shrubs", "Trees", "BareGround"};
+ char *RelAbundanceL1Names[] = {"SW_TREES", "SW_SHRUB", "SW_FORBS", "SW_GRASS", "SW_BAREGROUND"};
+ char *finalListNames[] = {"Rel_Abundance_L0", "Rel_Abundance_L1", "Grasses"};
+ char *grassesNames[] = {"Grasses_C3", "Grasses_C4", "Grasses_Annuals"};
+
+ // "inter_" meaning the intermediate R -> C conversion
+ int index, julyMin = 0, degAbove65 = 1, frostFreeDays = 2;
+
+ Bool final_fill_empty_with_BareGround = (Bool) asLogical(fill_empty_with_BareGround) ? swTRUE : swFALSE,
+ final_warn_extrapolation = (Bool) asLogical(warn_extrapolation) ? swTRUE : swFALSE,
+ final_isNorth = (Bool) asLogical(isNorth) ? swTRUE : swFALSE,
+ final_fix_bareGround = (Bool) asLogical(fixBareGround) ? swTRUE : swFALSE;
+
+ SEXP cRelAbL1Names, cRelAbL0Names, cfinalNames, cgrasses,
+ final_RelAbundanceL1, final_RelAbundanceL0, final_grasses, res;
+
+ res = PROTECT(allocVector(VECSXP, 3));
+ final_RelAbundanceL0 = PROTECT(allocVector(REALSXP, 8));
+ final_RelAbundanceL1 = PROTECT(allocVector(REALSXP, 5));
+ final_grasses = PROTECT(allocVector(REALSXP, 3));
+ cRelAbL1Names = PROTECT(allocVector(STRSXP, 5));
+ cRelAbL0Names = PROTECT(allocVector(STRSXP, 8));
+ cfinalNames = PROTECT(allocVector(STRSXP, 3));
+ cgrasses = PROTECT(allocVector(STRSXP, 3));
+
+ for(index = 0; index < 3; index++) {
+ SET_STRING_ELT(cfinalNames, index, mkChar(finalListNames[index]));
+ SET_STRING_ELT(cgrasses, index, mkChar(grassesNames[index]));
+ }
+
+ for(index = 0; index < 8; index++) {
+ SET_STRING_ELT(cRelAbL0Names, index, mkChar(RelAbundanceL0Names[index]));
+ if(index < 5) SET_STRING_ELT(cRelAbL1Names, index, mkChar(RelAbundanceL1Names[index]));
+ }
+
+ namesgets(final_RelAbundanceL0, cRelAbL0Names);
+ namesgets(final_RelAbundanceL1, cRelAbL1Names);
+ namesgets(res, cfinalNames);
+ namesgets(final_grasses, cgrasses);
+
+ for(index = 0; index < MAX_MONTHS; index++) {
+ final_MonPPT_cm[index] = REAL(mean_monthly_ppt_mm)[index] / 10;
+ final_MonTemp_C[index] = REAL(mean_monthly_Temp_C)[index];
+ }
+
+ // Check if dailyC4vars is not NULL and assume that not NA/NAN
+ if(!isNull(dailyC4vars)) {
+ // Coerce `dailyC4vars` to numeric (double)
+ dailyC4vars = PROTECT(coerceVector(dailyC4vars, REALSXP));
+ C4Variables[julyMin] = REAL(dailyC4vars)[0];
+ C4Variables[frostFreeDays] = REAL(dailyC4vars)[1];
+ C4Variables[degAbove65] = REAL(dailyC4vars)[2];
+ UNPROTECT(1);
+ } else {
+ C4Variables[0] = SW_MISSING;
+ C4Variables[1] = SW_MISSING;
+ C4Variables[2] = SW_MISSING;
+ }
+
+ estimatePotNatVegComposition(final_MAT_C, final_MAP_cm, final_MonTemp_C,
+ final_MonPPT_cm, inputValues_D, final_shrubLimit, final_SumGrassesFraction, C4Variables,
+ final_fill_empty_with_BareGround, final_isNorth, final_warn_extrapolation,
+ final_fix_bareGround, grasses, RelAbundanceL0, RelAbundanceL1);
+
+ for(index = 0; index < 8; index++) {
+ REAL(final_RelAbundanceL0)[index] = RelAbundanceL0[index];
+ if(index < 5) {
+ REAL(final_RelAbundanceL1)[index] = RelAbundanceL1[index];
+ }
+ if(index < 3) {
+ REAL(final_grasses)[index] = grasses[index];
+ }
+ }
+
+ SET_VECTOR_ELT(res, 0, final_RelAbundanceL0);
+ SET_VECTOR_ELT(res, 1, final_RelAbundanceL1);
+ SET_VECTOR_ELT(res, 2, final_grasses);
+
+ UNPROTECT(8);
+
+ return res;
+
}
diff --git a/src/rSW_VegProd.h b/src/rSW_VegProd.h
index 6cd921eb..b1d0d559 100644
--- a/src/rSW_VegProd.h
+++ b/src/rSW_VegProd.h
@@ -3,6 +3,12 @@
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_VPD();
+SEXP onGet_SW_VPD(void);
void onSet_SW_VPD(SEXP SW_VPD);
+SEXP rSW2_estimate_PotNatVeg_composition(SEXP MAP_mm, SEXP MAT_C, SEXP mean_monthly_ppt_mm,
+ SEXP mean_monthly_Temp_C, SEXP shrub_limit, SEXP SumGrasses_Fraction,
+ SEXP fill_empty_with_BareGround, SEXP warn_extrapolation, SEXP dailyC4vars,
+ SEXP isNorth, SEXP fixBareGround, SEXP Succulents_Fraction, SEXP Annuals_Fraction,
+ SEXP C4_Fraction, SEXP C3_Fraction, SEXP Shrubs_Fraction, SEXP Forbs_Fraction,
+ SEXP Trees_Fraction, SEXP BareGround_Fraction);
diff --git a/src/rSW_Weather.c b/src/rSW_Weather.c
index 7caa3272..e7f432eb 100644
--- a/src/rSW_Weather.c
+++ b/src/rSW_Weather.c
@@ -13,18 +13,19 @@
#include
#include
-#include "SOILWAT2/generic.h"
-#include "SOILWAT2/filefuncs.h"
-#include "SOILWAT2/Times.h"
-#include "SOILWAT2/myMemory.h"
-
-#include "SOILWAT2/SW_Defines.h"
-#include "SOILWAT2/SW_Files.h"
-#include "SOILWAT2/SW_Model.h" // externs `SW_Model`
-#include "SOILWAT2/SW_Markov.h"
-#include "SOILWAT2/SW_Sky.h"
-
-#include "SOILWAT2/SW_Weather.h" // externs `SW_Weather`
+#include "SOILWAT2/include/generic.h"
+#include "SOILWAT2/include/filefuncs.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/myMemory.h"
+#include "SOILWAT2/include/SW_Flow_lib_PET.h"
+
+#include "SOILWAT2/include/SW_Defines.h"
+#include "SOILWAT2/include/SW_Files.h"
+#include "SOILWAT2/include/SW_Model.h" // externs `SW_Model`
+#include "SOILWAT2/include/SW_Markov.h"
+#include "SOILWAT2/include/SW_Sky.h"
+
+#include "SOILWAT2/include/SW_Weather.h" // externs `SW_Weather`
#include "rSW_Weather.h"
#include "SW_R_lib.h" // externs `InputData`, `WeatherList`, `bWeatherList`
@@ -39,10 +40,18 @@
static char *MyFileName;
static char *cSW_WTH_names[] = {
- "UseSnow", "pct_SnowDrift", "pct_SnowRunoff",
- "use_weathergenerator", "use_weathergenerator_only",
- "FirstYear_Historical",
- "MonthlyScalingParams"
+ "MonthlyScalingParams",
+ "UseSnow",
+ "pct_SnowDrift",
+ "pct_SnowRunoff",
+ "use_weathergenerator",
+ "use_weathergenerator_only",
+ "FirstYear_Historical", // removed from SOILWAT2; kept here for backwards compatibility
+ "use_cloudCoverMonthly",
+ "use_windSpeedMonthly",
+ "use_humidityMonthly",
+ "desc_rsds",
+ "dailyInputFlags"
};
@@ -52,51 +61,62 @@ static char *cSW_WTH_names[] = {
/* --------------------------------------------------- */
static SEXP onGet_WTH_DATA_YEAR(TimeInt year);
-static Bool onSet_WTH_DATA(SEXP WTH_DATA_YEAR, TimeInt year);
-
-
+static void rSW2_setAllWeather(
+ SEXP listAllW,
+ SW_WEATHER_HIST **allHist,
+ int startYear,
+ unsigned int n_years,
+ Bool use_weathergenerator_only,
+ Bool use_cloudCoverMonthly,
+ Bool use_humidityMonthly,
+ Bool use_windSpeedMonthly,
+ Bool *dailyInputFlags,
+ RealD *cloudcov,
+ RealD *windspeed,
+ RealD *r_humidity
+);
+
+static void rSW2_set_weather_hist(
+ SEXP listAllW,
+ TimeInt year,
+ SW_WEATHER_HIST *yearWeather,
+ Bool *dailyInputFlags
+);
+
+static double value_or_missing(double x) {
+ return (R_FINITE(x) && !missing(x)) ? x : SW_MISSING;
+}
/* =================================================== */
/* Global Function Definitions */
/* --------------------------------------------------- */
-Bool onSet_WTH_DATA_YEAR(TimeInt year) {
- int i = 0;
- Bool has_weather = FALSE;
-
- if (bWeatherList) {
- for (i = 0; i < LENGTH(WeatherList); i++) {
- if (year == *INTEGER(GET_SLOT(VECTOR_ELT(WeatherList, i), install("year")))) {
- has_weather = onSet_WTH_DATA(GET_SLOT(VECTOR_ELT(WeatherList, i), install("data")), year);
- }
- }
-
- } else {
- for (i = 0; i < LENGTH(GET_SLOT(InputData, install("weatherHistory"))); i++) {
- if (year == *INTEGER(GET_SLOT(VECTOR_ELT(GET_SLOT(InputData, install("weatherHistory")), i), install("year")))) {
- has_weather = onSet_WTH_DATA(GET_SLOT(VECTOR_ELT(GET_SLOT(InputData, install("weatherHistory")), i), install("data")), year);
- }
- }
- }
- return has_weather;
-}
+/**
+ @brief Copy weather setup from `SOILWAT2` `SW_WEATHER`
+ to `rSOILWAT2` S4 `swWeather`
-SEXP onGet_SW_WTH() {
+ Called by `onGetInputDataFromFiles()`.
+*/
+SEXP onGet_SW_WTH_setup(void) {
int i;
- const int nitems = 6;
+ const int nitems = 8;
RealD *p_MonthlyValues;
SW_WEATHER *w = &SW_Weather;
SEXP swWeather;
SEXP SW_WTH;
- SEXP
- use_snow, pct_snowdrift, pct_snowRunoff,
- use_weathergenerator, use_weathergenerator_only, yr_first;
+ SEXP
+ use_snow, pct_snowdrift, pct_snowRunoff,
+ use_weathergenerator, use_weathergenerator_only,
+ yr_first,
+ use_cloudCoverMonthly, use_windSpeedMonthly, use_humidityMonthly,
+ desc_rsds,
+ dailyInputFlags;
SEXP MonthlyScalingParams, MonthlyScalingParams_names, MonthlyScalingParams_names_x, MonthlyScalingParams_names_y;
- char *cMonthlyScalingParams_names[] = {"PPT", "MaxT", "MinT", "SkyCover", "Wind", "rH"};
+ char *cMonthlyScalingParams_names[] = {"PPT", "MaxT", "MinT", "SkyCover", "Wind", "rH", "ActVP", "ShortWR"};
char *cMonths[] = {"January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"};
PROTECT(swWeather = MAKE_CLASS("swWeather"));
@@ -109,11 +129,29 @@ SEXP onGet_SW_WTH() {
PROTECT(pct_snowRunoff = NEW_NUMERIC(1));
REAL(pct_snowRunoff)[0] = w->pct_snowRunoff;
PROTECT(use_weathergenerator = NEW_LOGICAL(1));
- LOGICAL_POINTER(use_weathergenerator)[0] = w->use_weathergenerator;
+ LOGICAL_POINTER(use_weathergenerator)[0] = w->generateWeatherMethod == 2;
PROTECT(use_weathergenerator_only = NEW_LOGICAL(1));
LOGICAL_POINTER(use_weathergenerator_only)[0] = w->use_weathergenerator_only;
PROTECT(yr_first = NEW_INTEGER(1));
+ /* `SW_weather.yr` was removed from SOILWAT2:
INTEGER_POINTER(yr_first)[0] = w->yr.first;
+ */
+ INTEGER_POINTER(yr_first)[0] = SW_Weather.startYear;
+
+ PROTECT(use_cloudCoverMonthly = NEW_LOGICAL(1));
+ LOGICAL_POINTER(use_cloudCoverMonthly)[0] = w->use_cloudCoverMonthly;
+ PROTECT(use_windSpeedMonthly = NEW_LOGICAL(1));
+ LOGICAL_POINTER(use_windSpeedMonthly)[0] = w->use_windSpeedMonthly;
+ PROTECT(use_humidityMonthly = NEW_LOGICAL(1));
+ LOGICAL_POINTER(use_humidityMonthly)[0] = w->use_humidityMonthly;
+
+ PROTECT(desc_rsds = NEW_INTEGER(1));
+ INTEGER_POINTER(desc_rsds)[0] = w->desc_rsds;
+
+ PROTECT(dailyInputFlags = allocVector(LGLSXP, MAX_INPUT_COLUMNS));
+ for (i = 0; i < MAX_INPUT_COLUMNS; i++) {
+ LOGICAL_POINTER(dailyInputFlags)[i] = w->dailyInputFlags[i];
+ }
PROTECT(MonthlyScalingParams = allocMatrix(REALSXP, 12, nitems));
p_MonthlyValues = REAL(MonthlyScalingParams);
@@ -124,6 +162,8 @@ SEXP onGet_SW_WTH() {
p_MonthlyValues[i + 12 * 3] = w->scale_skyCover[i];
p_MonthlyValues[i + 12 * 4] = w->scale_wind[i];
p_MonthlyValues[i + 12 * 5] = w->scale_rH[i];
+ p_MonthlyValues[i + 12 * 6] = w->scale_actVapPress[i];
+ p_MonthlyValues[i + 12 * 7] = w->scale_shortWaveRad[i];
}
PROTECT(MonthlyScalingParams_names = allocVector(VECSXP, 2));
PROTECT(MonthlyScalingParams_names_x = allocVector(STRSXP, 12));
@@ -136,49 +176,49 @@ SEXP onGet_SW_WTH() {
SET_VECTOR_ELT(MonthlyScalingParams_names, 1, MonthlyScalingParams_names_y);
setAttrib(MonthlyScalingParams, R_DimNamesSymbol, MonthlyScalingParams_names);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[0]), use_snow);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[1]), pct_snowdrift);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[2]), pct_snowRunoff);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[3]), use_weathergenerator);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[4]), use_weathergenerator_only);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[5]), yr_first);
- SET_SLOT(SW_WTH, install(cSW_WTH_names[6]), MonthlyScalingParams);
-
- UNPROTECT(12);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[0]), MonthlyScalingParams);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[1]), use_snow);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[2]), pct_snowdrift);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[3]), pct_snowRunoff);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[4]), use_weathergenerator);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[5]), use_weathergenerator_only);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[6]), yr_first);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[7]), use_cloudCoverMonthly);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[8]), use_windSpeedMonthly);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[9]), use_humidityMonthly);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[10]), desc_rsds);
+ SET_SLOT(SW_WTH, install(cSW_WTH_names[11]), dailyInputFlags);
+
+
+ UNPROTECT(17);
return SW_WTH;
}
-void onSet_SW_WTH(SEXP SW_WTH) {
- int i, tmp;
+
+/**
+ @brief Copy weather setup from `rSOILWAT2` S4 `swWeather`
+ to `SOILWAT2` `SW_WEATHER`
+
+ Called by `rSW_CTL_obtain_inputs()` if `from_files` is `FALSE`.
+*/
+void onSet_SW_WTH_setup(SEXP SW_WTH) {
+ int i;
SW_WEATHER *w = &SW_Weather;
SEXP
- use_snow, pct_snowdrift, pct_snowRunoff,
- use_weathergenerator, use_weathergenerator_only, yr_first;
+ use_snow, pct_snowdrift, pct_snowRunoff,
+ use_weathergenerator, use_weathergenerator_only,
+ use_cloudCoverMonthly, use_windSpeedMonthly, use_humidityMonthly,
+ desc_rsds,
+ dailyInputFlags;
SEXP MonthlyScalingParams;
RealD *p_MonthlyValues;
+ int *p_dailyInputFlags;
MyFileName = SW_F_name(eWeather);
- PROTECT(use_snow = GET_SLOT(SW_WTH, install(cSW_WTH_names[0])));
- w->use_snow = (Bool) *INTEGER(use_snow);
- PROTECT(pct_snowdrift = GET_SLOT(SW_WTH, install(cSW_WTH_names[1])));
- w->pct_snowdrift = *REAL(pct_snowdrift);
- PROTECT(pct_snowRunoff = GET_SLOT(SW_WTH, install(cSW_WTH_names[2])));
- w->pct_snowRunoff = *REAL(pct_snowRunoff);
-
- PROTECT(use_weathergenerator = GET_SLOT(SW_WTH, install(cSW_WTH_names[3])));
- w->use_weathergenerator = (Bool) *INTEGER(use_weathergenerator);
- PROTECT(use_weathergenerator_only = GET_SLOT(SW_WTH, install(cSW_WTH_names[4])));
- w->use_weathergenerator_only = (Bool) *INTEGER(use_weathergenerator_only);
- if (w->use_weathergenerator_only) {
- w->use_weathergenerator = TRUE;
- }
-
- PROTECT(yr_first = GET_SLOT(SW_WTH, install(cSW_WTH_names[5])));
- tmp = *INTEGER(yr_first);
- w->yr.first = (tmp < 0) ? SW_Model.startyr : yearto4digit(tmp);
+ SW_WeatherPrefix(w->name_prefix);
- PROTECT(MonthlyScalingParams = GET_SLOT(SW_WTH, install(cSW_WTH_names[6])));
+ PROTECT(MonthlyScalingParams = GET_SLOT(SW_WTH, install(cSW_WTH_names[0])));
p_MonthlyValues = REAL(MonthlyScalingParams);
for (i = 0; i < 12; i++) {
w->scale_precip[i] = p_MonthlyValues[i + 12 * 0];
@@ -187,66 +227,98 @@ void onSet_SW_WTH(SEXP SW_WTH) {
w->scale_skyCover[i] = p_MonthlyValues[i + 12 * 3];
w->scale_wind[i] = p_MonthlyValues[i + 12 * 4];
w->scale_rH[i] = p_MonthlyValues[i + 12 * 5];
+ w->scale_actVapPress[i] = p_MonthlyValues[i + 12 * 6];
+ w->scale_shortWaveRad[i] = p_MonthlyValues[i + 12 * 7];
}
- SW_WeatherPrefix(w->name_prefix);
+ PROTECT(use_snow = GET_SLOT(SW_WTH, install(cSW_WTH_names[1])));
+ w->use_snow = (Bool) *INTEGER(use_snow);
+ PROTECT(pct_snowdrift = GET_SLOT(SW_WTH, install(cSW_WTH_names[2])));
+ w->pct_snowdrift = *REAL(pct_snowdrift);
+ PROTECT(pct_snowRunoff = GET_SLOT(SW_WTH, install(cSW_WTH_names[3])));
+ w->pct_snowRunoff = *REAL(pct_snowRunoff);
+
+ PROTECT(use_weathergenerator = GET_SLOT(SW_WTH, install(cSW_WTH_names[4])));
+ w->generateWeatherMethod = *INTEGER(use_weathergenerator) ? 2 : 0;
+ PROTECT(use_weathergenerator_only = GET_SLOT(SW_WTH, install(cSW_WTH_names[5])));
+ w->use_weathergenerator_only = (Bool) *INTEGER(use_weathergenerator_only);
+ if (w->use_weathergenerator_only) {
+ w->generateWeatherMethod = 2;
+ }
+
+ /* `SW_weather.yr` was removed from SOILWAT2:
+ SEXP yr_first;
+ int tmp;
+
+ PROTECT(yr_first = GET_SLOT(SW_WTH, install(cSW_WTH_names[6])));
+ tmp = *INTEGER(yr_first);
+ w->yr.first = (tmp < 0) ? SW_Model.startyr : yearto4digit(tmp);
+ */
+
+ PROTECT(use_cloudCoverMonthly = GET_SLOT(SW_WTH, install(cSW_WTH_names[7])));
+ w->use_cloudCoverMonthly = (Bool) *INTEGER(use_cloudCoverMonthly);
+ PROTECT(use_windSpeedMonthly = GET_SLOT(SW_WTH, install(cSW_WTH_names[8])));
+ w->use_windSpeedMonthly = (Bool) *INTEGER(use_windSpeedMonthly);
+ PROTECT(use_humidityMonthly = GET_SLOT(SW_WTH, install(cSW_WTH_names[9])));
+ w->use_humidityMonthly = (Bool) *INTEGER(use_humidityMonthly);
+
+ PROTECT(desc_rsds = GET_SLOT(SW_WTH, install(cSW_WTH_names[10])));
+ w->desc_rsds = (unsigned int) *INTEGER(desc_rsds);
+
+ PROTECT(dailyInputFlags = GET_SLOT(SW_WTH, install(cSW_WTH_names[11])));
+ p_dailyInputFlags = INTEGER(dailyInputFlags);
+ for (i = 0; i < MAX_INPUT_COLUMNS; i++) {
+ w->dailyInputFlags[i] = (Bool) p_dailyInputFlags[i];
+ }
+ /* `SW_weather.yr` was removed from SOILWAT2:
w->yr.last = SW_Model.endyr;
w->yr.total = w->yr.last - w->yr.first + 1;
- if (!w->use_weathergenerator && SW_Model.startyr < w->yr.first) {
+ if (SW_Weather.generateWeatherMethod != 2 && SW_Model.startyr < w->yr.first) {
LogError(
logfp,
LOGFATAL,
"%s : Model year (%d) starts before weather files (%d)"
- " and use_weathergenerator=swFALSE.\nPlease synchronize the years"
- " or set up the Markov weather files",
- MyFileName, SW_Model.startyr, w->yr.first
+ " and weather generator turned off.\n"
+ " Please synchronize the years or set up the weather generator files",
+ MyFileName, SW_Model.startyr, w->startYear
);
}
+ */
+
+ check_and_update_dailyInputFlags(
+ w->use_cloudCoverMonthly,
+ w->use_humidityMonthly,
+ w->use_windSpeedMonthly,
+ w->dailyInputFlags
+ );
- UNPROTECT(7);
+ UNPROTECT(11);
}
+
+/**
+ @brief Copy all weather data from `SOILWAT2` data structure
+ to `rSOILWAT2` list of `swWeatherData`
+
+ Called by `onGetInputDataFromFiles()`
+*/
SEXP onGet_WTH_DATA(void) {
- TimeInt year;
+ TimeInt year, yearIndex;
SEXP WTH_DATA, WTH_DATA_names;
- Bool has_weather = FALSE;
char cYear[5];
- int n_yrs, i;
-
- // number of years
- n_yrs = SW_Model.endyr - SW_Model.startyr + 1;
- PROTECT(WTH_DATA = allocVector(VECSXP, n_yrs));
- PROTECT(WTH_DATA_names = allocVector(STRSXP, n_yrs));
-
- for (year = SW_Model.startyr, i = 0; year <= SW_Model.endyr; year++, i++) {
- sprintf(cYear, "%4d", year);
- SET_STRING_ELT(WTH_DATA_names, i, mkChar(cYear));
-
- if (SW_Weather.use_weathergenerator_only) {
- has_weather = FALSE;
-
- } else {
- has_weather = _read_weather_hist(year);
- }
-
- if (has_weather) {
- // copy values from SOILWAT2 variables to rSOILWAT2 S4 class object
- SET_VECTOR_ELT(WTH_DATA, i, onGet_WTH_DATA_YEAR(year));
-
- } else if (SW_Weather.use_weathergenerator) {
- // set the missing values from SOILWAT2 into rSOILWAT2 S4 weather object
- SET_VECTOR_ELT(WTH_DATA, i, onGet_WTH_DATA_YEAR(year));
-
- } else {
- LogError(
- logfp,
- LOGFATAL,
- "Markov Simulator turned off and weather file found not for year %d",
- year
- );
- }
+
+ PROTECT(WTH_DATA = allocVector(VECSXP, SW_Weather.n_years));
+ PROTECT(WTH_DATA_names = allocVector(STRSXP, SW_Weather.n_years));
+
+ for (yearIndex = 0; yearIndex < SW_Weather.n_years; yearIndex++) {
+ year = SW_Weather.startYear + yearIndex;
+ snprintf(cYear, sizeof cYear, "%4d", year);
+ SET_STRING_ELT(WTH_DATA_names, yearIndex, mkChar(cYear));
+
+ // copy values from SOILWAT2 variables to rSOILWAT2 S4 class object
+ SET_VECTOR_ELT(WTH_DATA, yearIndex, onGet_WTH_DATA_YEAR(year));
}
setAttrib(WTH_DATA, R_NamesSymbol, WTH_DATA_names);
@@ -255,18 +327,39 @@ SEXP onGet_WTH_DATA(void) {
return WTH_DATA;
}
+
+/**
+ @brief Copy weather data for `year` from `SOILWAT2` data structure
+ to `rSOILWAT2` `swWeatherData`
+
+ Daily weather elements that are not internally stored by `SOILWAT2` are
+ returned as missing values; these are
+ `"windSpeed_east_mPERs"`, `"windSpeed_north_mPERs"`,
+ `"rHmax_pct"`, `"rHmin_pct"`, `"specHavg_pct"`, `"Tdewpoint_C"`
+
+ Called by `onGet_WTH_DATA()`
+*/
SEXP onGet_WTH_DATA_YEAR(TimeInt year) {
- int i,days;
- const int nitems = 4;
+ int i, days, yearIndex;
+ const int nitems = 15;
SEXP swWeatherData;
SEXP WeatherData;
SEXP Year, Year_names, Year_names_y;
SEXP nYear;
- char *cYear[] = {"DOY", "Tmax_C", "Tmin_C", "PPT_cm"};
+ char *cYear[] = {
+ "DOY",
+ "Tmax_C", "Tmin_C", "PPT_cm",
+ "cloudCov_pct",
+ "windSpeed_mPERs", "windSpeed_east_mPERs", "windSpeed_north_mPERs",
+ "rHavg_pct", "rHmax_pct", "rHmin_pct", "specHavg_pct", "Tdewpoint_C",
+ "actVP_kPa",
+ "shortWR"
+ };
RealD *p_Year;
- SW_WEATHER_HIST *wh = &SW_Weather.hist;
+ SW_WEATHER *w = &SW_Weather;
days = Time_get_lastdoy_y(year);
+ yearIndex = year - SW_Weather.startYear;
PROTECT(swWeatherData = MAKE_CLASS("swWeatherData"));
PROTECT(WeatherData = NEW_OBJECT(swWeatherData));
@@ -278,9 +371,24 @@ SEXP onGet_WTH_DATA_YEAR(TimeInt year) {
p_Year = REAL(Year);
for (i = 0; i < days; i++) {
p_Year[i + days * 0] = (i + 1);
- p_Year[i + days * 1] = wh->temp_max[i];
- p_Year[i + days * 2] = wh->temp_min[i];
- p_Year[i + days * 3] = wh->ppt[i];
+ p_Year[i + days * (TEMP_MAX + 1)] = w->allHist[yearIndex]->temp_max[i];
+ p_Year[i + days * (TEMP_MIN + 1)] = w->allHist[yearIndex]->temp_min[i];
+ p_Year[i + days * (PPT + 1)] = w->allHist[yearIndex]->ppt[i];
+
+ p_Year[i + days * (CLOUD_COV + 1)] = w->allHist[yearIndex]->cloudcov_daily[i];
+
+ p_Year[i + days * (WIND_SPEED + 1)] = w->allHist[yearIndex]->windspeed_daily[i];
+ p_Year[i + days * (WIND_EAST + 1)] = NA_REAL; // windSpeed_east_mPERs
+ p_Year[i + days * (WIND_NORTH + 1)] = NA_REAL; // windSpeed_north_mPERs
+
+ p_Year[i + days * (REL_HUMID + 1)] = w->allHist[yearIndex]->r_humidity_daily[i];
+ p_Year[i + days * (REL_HUMID_MAX + 1)] = NA_REAL; // rHmax_pct
+ p_Year[i + days * (REL_HUMID_MIN + 1)] = NA_REAL; // rHmin_pct
+ p_Year[i + days * (SPEC_HUMID + 1)] = NA_REAL; // specHavg_pct
+ p_Year[i + days * (TEMP_DEWPOINT + 1)] = NA_REAL; // Tdewpoint_C
+
+ p_Year[i + days * (ACTUAL_VP + 1)] = w->allHist[yearIndex]->actualVaporPressure[i];
+ p_Year[i + days * (SHORT_WR + 1)] = w->allHist[yearIndex]->shortWaveRad[i];
}
PROTECT(Year_names = allocVector(VECSXP, 2));
@@ -298,60 +406,545 @@ SEXP onGet_WTH_DATA_YEAR(TimeInt year) {
return WeatherData;
}
-Bool onSet_WTH_DATA(SEXP WTH_DATA_YEAR, TimeInt year) {
- SW_WEATHER_HIST *wh = &SW_Weather.hist;
- int lineno = 0, i, j, days;
- Bool has_values = FALSE;
- RealD *p_WTH_DATA;
- TimeInt doy;
- if (isnull(WTH_DATA_YEAR)) {
- return FALSE; // no weather data for this year --> use weather generator
- }
- days = Time_get_lastdoy_y(year);
+/**
+ @brief Move all weather data from `rSOILWAT2` to `SOILWAT2`
- if (nrows(WTH_DATA_YEAR) != days || ncols(WTH_DATA_YEAR) != 4) {
- LogError(logfp, LOGFATAL, "weath.%4d : Wrong number of days or columns in data. Expected rows %d had %d. Expected columns 4 had %d.", year, days,nrows(WTH_DATA_YEAR),ncols(WTH_DATA_YEAR));
- return FALSE;
- }
+ Equivalent functionality to `SW_WTH_read()`with the difference that
+ `SOILWAT2` `allHist` is filled with values that are
+ copied from `rSOILWAT2` list of `swWeatherData`
+ instead of being read from files on disk.
- p_WTH_DATA = REAL(WTH_DATA_YEAR);
- _clear_hist_weather();
+ Called by `rSW_CTL_obtain_inputs()` if `from_files` is `FALSE`.
+
+ @note Elements `endyr` and `startyr` of `SW_Model` must be set/updated
+ via `onSet_SW_MDL()` before this function is called.
+
+ @note `SW_Weather` (via `onSet_SW_WTH_setup()`) and
+ `SW_Sky` (via `onSet_SW_SKY()`) must be set/updated
+ before this function is called.
+*/
+void onSet_WTH_DATA(void) {
+
+ SEXP listAllWeather;
+
+ // Determine which `rSOILWAT2` list of `swWeatherData` we are using
+ listAllWeather = bWeatherList ?
+ WeatherList :
+ GET_SLOT(InputData, install("weatherHistory"));
+
+
+ // Deallocate (previous, if any) `allHist`
+ // (using value of `SW_Weather.n_years` previously used to allocate)
+ // `SW_WTH_construct()` sets `n_years` to zero
+ deallocateAllWeather(&SW_Weather);
+
+ // Update number of years and first calendar year represented
+ SW_Weather.n_years = SW_Model.endyr - SW_Model.startyr + 1;
+ SW_Weather.startYear = SW_Model.startyr;
+
+ // Allocate new `allHist` (based on current `SW_Weather.n_years`)
+ allocateAllWeather(&SW_Weather);
+
+
+ // Equivalent to `readAllWeather()`:
+ // fill `SOILWAT2` `allHist` with values from `rSOILWAT2`
+ rSW2_setAllWeather(
+ listAllWeather,
+ SW_Weather.allHist,
+ SW_Weather.startYear,
+ SW_Weather.n_years,
+ SW_Weather.use_weathergenerator_only,
+ SW_Weather.use_cloudCoverMonthly,
+ SW_Weather.use_humidityMonthly,
+ SW_Weather.use_windSpeedMonthly,
+ SW_Weather.dailyInputFlags,
+ SW_Sky.cloudcov,
+ SW_Sky.windspeed,
+ SW_Sky.r_humidity
+ );
+}
+
+
+// Equivalent to `readAllWeather()`:
+// fill `SOILWAT2` `allHist` with values from `rSOILWAT2`
+static void rSW2_setAllWeather(
+ SEXP listAllW,
+ SW_WEATHER_HIST **allHist,
+ int startYear,
+ unsigned int n_years,
+ Bool use_weathergenerator_only,
+ Bool use_cloudCoverMonthly,
+ Bool use_humidityMonthly,
+ Bool use_windSpeedMonthly,
+ Bool *dailyInputFlags,
+ RealD *cloudcov,
+ RealD *windspeed,
+ RealD *r_humidity
+) {
+ unsigned int yearIndex, year;
+
+ /* Interpolation is to be in base0 in `interpolate_monthlyValues()` */
+ Bool interpAsBase1 = swFALSE;
+
+ for(yearIndex = 0; yearIndex < n_years; yearIndex++) {
+ year = yearIndex + startYear;
+
+ // Set all daily weather values to missing
+ _clear_hist_weather(allHist[yearIndex]);
+
+ // Update yearly day/month information needed when interpolating
+ // cloud cover, wind speed, and relative humidity if necessary
+ Time_new_year(year);
+
+ if(use_cloudCoverMonthly) {
+ interpolate_monthlyValues(cloudcov, interpAsBase1, allHist[yearIndex]->cloudcov_daily);
+ }
+
+ if(use_humidityMonthly) {
+ interpolate_monthlyValues(r_humidity, interpAsBase1, allHist[yearIndex]->r_humidity_daily);
+ }
+
+ if(use_windSpeedMonthly) {
+ interpolate_monthlyValues(windspeed, interpAsBase1, allHist[yearIndex]->windspeed_daily);
+ }
+
+ // Read daily weather values from disk
+ if (!use_weathergenerator_only) {
+
+ rSW2_set_weather_hist(
+ listAllW,
+ year,
+ allHist[yearIndex],
+ dailyInputFlags
+ );
+ }
+ }
+}
+
+
+// Equivalent to `_read_weather_hist()`:
+// fill `SOILWAT2` `allHist` with values from `rSOILWAT2`
+static void rSW2_set_weather_hist(
+ SEXP listAllW,
+ TimeInt year,
+ SW_WEATHER_HIST *yearWeather,
+ Bool *dailyInputFlags
+) {
+
+ // Locate suitable year among rSOILWAT2 list of `swWeatherData`
+ int i, nList = LENGTH(listAllW);
+ TimeInt numDaysYear;
+ Bool weth_found = FALSE;
+ SEXP tmpW, yrWData;
+ double *p_yrWData;
+
+ for (i = 0; !weth_found && i < nList; i++) {
+ tmpW = VECTOR_ELT(listAllW, i);
+ weth_found = (Bool) year == *INTEGER(GET_SLOT(tmpW, install("year")));
+ }
+
+ if (weth_found) {
+ yrWData = GET_SLOT(tmpW, install("data"));
+ weth_found = !isnull(yrWData);
+ }
+
+ if (!weth_found) {
+ return;
+ }
+
+ numDaysYear = Time_get_lastdoy_y(year);
+ if (nrows(yrWData) != numDaysYear) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "Weather data (year %d): "
+ "expected %d rows (had %d).\n",
+ year,
+ numDaysYear,
+ nrows(yrWData)
+ );
+ return;
+ }
+
+ // Suitable year among rSOILWAT2 weather list located
+ p_yrWData = REAL(yrWData);
+
+
+ // Copy values from rSOILWAT2 to SOILWAT2
+ int doy;
+
+ // Pre-calculate logic for calculation of daily variables
+ Bool hasMaxMinTemp = (Bool) (dailyInputFlags[TEMP_MAX] && dailyInputFlags[TEMP_MIN]);
+ Bool hasMaxMinRelHumid = (Bool) (dailyInputFlags[REL_HUMID_MAX] && dailyInputFlags[REL_HUMID_MIN]);
+ Bool hasEastNorthWind = (Bool) (dailyInputFlags[WIND_EAST] && dailyInputFlags[WIND_NORTH]);
+
+ // Calculate if daily input values of humidity are to be used instead of
+ // being interpolated from monthly values
+ Bool useHumidityDaily = (Bool) (hasMaxMinRelHumid || dailyInputFlags[REL_HUMID] ||
+ dailyInputFlags[SPEC_HUMID] || dailyInputFlags[ACTUAL_VP]);
+
+ double v1, v2, es, e, relHum, tempSlope, svpVal;
+
+
+ // Loop over days of current year
+ for (doy = 0; doy < numDaysYear; doy++) {
+
+ /* --- Make the assignments ---- */
+ // (Translate R's `NA` to SOILWAT2's `SW_MISSING`)
+
+ if (doy != p_yrWData[doy + numDaysYear * 0] - 1) {
+ LogError(
+ logfp,
+ LOGFATAL,
+ "Weather data (year %d): "
+ "day of year out of range (%d), expected: %d.\n",
+ year,
+ p_yrWData[doy + numDaysYear * 0],
+ doy + 1
+ );
+ }
+
+ // Maximum daily temperature [C]
+ yearWeather->temp_max[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (TEMP_MAX + 1)]
+ );
+
+ // Minimum daily temperature [C]
+ yearWeather->temp_min[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (TEMP_MIN + 1)]
+ );
+
+ // Calculate average air temperature if min/max not missing
+ if (
+ !missing(yearWeather->temp_max[doy]) &&
+ !missing(yearWeather->temp_min[doy])
+ ) {
+ yearWeather->temp_avg[doy] =
+ (yearWeather->temp_max[doy] + yearWeather->temp_min[doy]) / 2.0;
+ }
+
+ // Precipitation [cm]
+ yearWeather->ppt[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (PPT + 1)]
+ );
+
+
+ // Cloud cover [%]
+ if (dailyInputFlags[CLOUD_COV]) {
+ yearWeather->cloudcov_daily[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (CLOUD_COV + 1)]
+ );
+ }
+
+
+ // Wind speed [m/s]
+ if (dailyInputFlags[WIND_SPEED]) {
+ yearWeather->windspeed_daily[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (WIND_SPEED + 1)]
+ );
+
+ } else if (hasEastNorthWind) {
+
+ // Make sure wind is not calculated over SW_MISSING
+ v1 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (WIND_EAST + 1)]
+ );
+ v2 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (WIND_NORTH + 1)]
+ );
+
+ if (!missing(v1) && !missing(v2)) {
+ yearWeather->windspeed_daily[doy] = sqrt(
+ squared(v1) + squared(v2)
+ );
+ }
+ }
+
+
+ // Relative humidity [%]
+ if (useHumidityDaily) {
+ if (hasMaxMinRelHumid) {
+ // Make sure rH is not calculated over SW_MISSING
+ v1 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (REL_HUMID_MAX + 1)]
+ );
+ v2 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (REL_HUMID_MIN + 1)]
+ );
+
+ if (!missing(v1) && !missing(v2)) {
+ yearWeather->r_humidity_daily[doy] = (v1 + v2) / 2;
+ }
+
+ } else if (dailyInputFlags[REL_HUMID]) {
+ yearWeather->r_humidity_daily[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (REL_HUMID + 1)]
+ );
+
+ } else if (dailyInputFlags[SPEC_HUMID]) {
+ // Make sure rH is not calculated over SW_MISSING
+ v1 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (SPEC_HUMID + 1)]
+ );
+
+ if (!missing(yearWeather->temp_avg[doy]) && !missing(v1)) {
+ // Specific humidity (Bolton 1980)
+ es = 6.112 * exp(17.67 * yearWeather->temp_avg[doy]) /
+ (yearWeather->temp_avg[doy] + 243.5);
+
+ e = (v1 * 1013.25) / (.378 * v1 + .622);
+
+ relHum = e / es;
+ relHum = max(0., relHum);
+
+ yearWeather->r_humidity_daily[doy] = min(100., relHum);
+ }
+ }
+
+ // Actual vapor pressure [kPa]
+ if (dailyInputFlags[ACTUAL_VP]) {
+ yearWeather->actualVaporPressure[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (ACTUAL_VP + 1)]
+ );
+
+ } else {
+ v1 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (TEMP_DEWPOINT + 1)]
+ );
+
+
+ if (dailyInputFlags[TEMP_DEWPOINT] && !missing(v1)) {
+ yearWeather->actualVaporPressure[doy] = actualVaporPressure3(v1);
+
+ } else if (hasMaxMinTemp && hasMaxMinRelHumid) {
+ // Make sure vp is not calculated over SW_MISSING
+ v1 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (REL_HUMID_MAX + 1)]
+ );
+ v2 = value_or_missing(
+ p_yrWData[doy + numDaysYear * (REL_HUMID_MIN + 1)]
+ );
+
+ if (
+ !missing(yearWeather->temp_max[doy]) &&
+ !missing(yearWeather->temp_min[doy]) &&
+ !missing(v1) && !missing(v2)
+ ) {
+ yearWeather->actualVaporPressure[doy] = actualVaporPressure2(
+ v1,
+ v2,
+ yearWeather->temp_max[doy],
+ yearWeather->temp_min[doy]
+ );
+ }
+
+ } else if (dailyInputFlags[REL_HUMID] || dailyInputFlags[SPEC_HUMID]) {
+ if (
+ !missing(yearWeather->r_humidity_daily[doy]) &&
+ !missing(yearWeather->temp_avg[doy])
+ ) {
+ yearWeather->actualVaporPressure[doy] = actualVaporPressure1(
+ yearWeather->r_humidity_daily[doy],
+ yearWeather->temp_avg[doy]
+ );
+ }
+ }
+ }
+
+
+ // Relative humidity [%] if still missing
+ if (
+ missing(yearWeather->r_humidity_daily[doy]) &&
+ (dailyInputFlags[ACTUAL_VP] || dailyInputFlags[TEMP_DEWPOINT])
+ ) {
+ // Make sure rH is not calculated over SW_MISSING
+ if (
+ !missing(yearWeather->temp_avg[doy]) &&
+ !missing(yearWeather->actualVaporPressure[doy])
+ ) {
+ svpVal = svp(yearWeather->temp_avg[doy], &tempSlope);
+
+ yearWeather->r_humidity_daily[doy] =
+ yearWeather->actualVaporPressure[doy] / svpVal;
+ }
+ }
+ }
+
+
+ // Downward surface shortwave radiation
+ if (dailyInputFlags[SHORT_WR]) {
+ yearWeather->shortWaveRad[doy] = value_or_missing(
+ p_yrWData[doy + numDaysYear * (SHORT_WR + 1)]
+ );
+ }
+ }
+}
+
+SEXP rSW2_calc_SiteClimate(SEXP weatherList, SEXP yearStart, SEXP yearEnd,
+ SEXP do_C4vars, SEXP do_Cheatgrass_ClimVars, SEXP latitude) {
+
+ SW_WEATHER_HIST **allHist;
+
+ SW_CLIMATE_YEARLY climateOutput;
+ SW_CLIMATE_CLIM climateAverages;
+
+ int numYears = asInteger(yearEnd) - asInteger(yearStart) + 1, year, calcSiteOutputNum = 10,
+ index;
+
+ Bool dailyInputFlags[MAX_INPUT_COLUMNS];
+ double cloudcov[MAX_MONTHS], windspeed[MAX_MONTHS], r_humidity[MAX_MONTHS];
+
+ SEXP res, monthlyMean, monthlyMax, monthlyMin, monthlyPPT, MAT_C, MAP_cm, vectorNames,
+ C4Variables, Cheatgrass, cnamesC4SEXP, cnamesCheatgrassSEXP;
+
+ char *cnames[] = {"meanMonthlyTempC","minMonthlyTempC","maxMonthlyTempC",
+ "meanMonthlyPPTcm","MAP_cm","MAT_C", "dailyTempMin", "dailyTempMean",
+ "dailyC4vars","Cheatgrass_ClimVars"};
+
+ char *cnamesC4[] = {"Month7th_NSadj_MinTemp_C","LengthFreezeFreeGrowingPeriod_NSadj_Days",
+ "DegreeDaysAbove65F_NSadj_DaysC","Month7th_NSadj_MinTemp_C.sd", "LengthFreezeFreeGrowingPeriod_NSadj_Days.sd",
+ "DegreeDaysAbove65F_NSadj_DaysC.sd"};
+
+ char *cnamesCheatgrass[] = {"Month7th_PPT_mm","MeanTemp_ofDriestQuarter_C","MinTemp_of2ndMonth_C",
+ "Month7th_PPT_mm_SD","MeanTemp_ofDriestQuarter_C_SD","MinTemp_of2ndMonth_C_SD"};
+
+ Bool inNorthHem = asReal(latitude) > 0.0;
+
+ monthlyMean = PROTECT(allocVector(REALSXP, MAX_MONTHS));
+ monthlyMax = PROTECT(allocVector(REALSXP, MAX_MONTHS));
+ monthlyMin = PROTECT(allocVector(REALSXP, MAX_MONTHS));
+ monthlyPPT = PROTECT(allocVector(REALSXP, MAX_MONTHS));
+ MAT_C = PROTECT(allocVector(REALSXP, 1));
+ MAP_cm = PROTECT(allocVector(REALSXP, 1));
+ vectorNames = PROTECT(allocVector(STRSXP, calcSiteOutputNum));
+ cnamesC4SEXP = PROTECT(allocVector(STRSXP, 6));
+ cnamesCheatgrassSEXP = PROTECT(allocVector(STRSXP, 6));
+ C4Variables = PROTECT(allocVector(REALSXP, 6));
+ Cheatgrass = PROTECT(allocVector(REALSXP, 6));
+
+ allHist = (SW_WEATHER_HIST **)malloc(sizeof(SW_WEATHER_HIST *) * numYears);
+
+ for(year = 0; year < numYears; year++) {
+ allHist[year] = (SW_WEATHER_HIST *)malloc(sizeof(SW_WEATHER_HIST));
+ }
+
+ Time_init_model();
+
+ // Set `dailyInputFlags`: currently, `calcSiteClimate()` use only tmax, tmin, ppt
+ for (index = 0; index < MAX_INPUT_COLUMNS; index++) {
+ dailyInputFlags[index] = FALSE;
+ }
+ dailyInputFlags[TEMP_MAX] = TRUE;
+ dailyInputFlags[TEMP_MIN] = TRUE;
+ dailyInputFlags[PPT] = TRUE;
+
+ // Fill SOILWAT `allHist` with data from weatherList
+ rSW2_setAllWeather(
+ weatherList,
+ allHist,
+ asInteger(yearStart),
+ numYears,
+ FALSE, // use_weathergenerator_only
+ FALSE, // use_cloudCoverMonthly,
+ FALSE, // use_windSpeedMonthly,
+ FALSE, // use_humidityMonthly,
+ dailyInputFlags,
+ cloudcov,
+ windspeed,
+ r_humidity
+ );
+
+ // Allocate memory of structs for climate on SOILWAT side
+ allocateClimateStructs(numYears, &climateOutput, &climateAverages);
+
+ // Calculate climate variables
+ calcSiteClimate(allHist, numYears, asInteger(yearStart), inNorthHem, &climateOutput);
+
+ // Average climate variables
+ averageClimateAcrossYears(&climateOutput, numYears, &climateAverages);
+
+ res = PROTECT(allocVector(VECSXP, calcSiteOutputNum));
+
+ double *xmonthlyMean = REAL(monthlyMean), *xmonthlyMax = REAL(monthlyMax),
+ *xmonthlyMin = REAL(monthlyMin), *xmontlyPPT = REAL(monthlyPPT);
+
+ for(index = 0; index < MAX_MONTHS; index++) {
+ xmonthlyMean[index] = climateAverages.meanTempMon_C[index];
+ xmonthlyMax[index] = climateAverages.maxTempMon_C[index];
+ xmonthlyMin[index] = climateAverages.minTempMon_C[index];
+ xmontlyPPT[index] = climateAverages.PPTMon_cm[index];
+ }
+
+ for(index = 0; index < calcSiteOutputNum; index++) {
+ SET_STRING_ELT(vectorNames, index, mkChar(cnames[index]));
+ }
+
+ for(index = 0; index < 6; index++) {
+ SET_STRING_ELT(cnamesC4SEXP, index, mkChar(cnamesC4[index]));
+ SET_STRING_ELT(cnamesCheatgrassSEXP, index, mkChar(cnamesCheatgrass[index]));
+ }
+
+ // Set names of res, C4Variables and Cheatgrass
+ namesgets(res, vectorNames);
+ namesgets(C4Variables, cnamesC4SEXP);
+ namesgets(Cheatgrass, cnamesCheatgrassSEXP);
+
+ // Set mean annual temperature and precipitation values
+ REAL(MAT_C)[0] = climateAverages.meanTemp_C;
+ REAL(MAP_cm)[0] = climateAverages.PPT_cm;
+
+ // Set C4Variables and Cheatgrass values
+
+ REAL(C4Variables)[0] = climateAverages.minTemp7thMon_C;
+ REAL(C4Variables)[1] = climateAverages.frostFree_days;
+ REAL(C4Variables)[2] = climateAverages.ddAbove65F_degday;
+
+ REAL(C4Variables)[3] = climateAverages.sdC4[0];
+ REAL(C4Variables)[4] = climateAverages.sdC4[1];
+ REAL(C4Variables)[5] = climateAverages.sdC4[2];
+
+ REAL(Cheatgrass)[0] = climateAverages.PPT7thMon_mm;
+ REAL(Cheatgrass)[1] = climateAverages.meanTempDriestQtr_C;
+ REAL(Cheatgrass)[2] = climateAverages.minTemp2ndMon_C;
+
+ REAL(Cheatgrass)[3] = climateAverages.sdCheatgrass[0];
+ REAL(Cheatgrass)[4] = climateAverages.sdCheatgrass[1];
+ REAL(Cheatgrass)[5] = climateAverages.sdCheatgrass[2];
+
+ // Set mean average monthly temperature
+ SET_VECTOR_ELT(res, 0, monthlyMean);
+
+ // Set mean minimum temperature
+ SET_VECTOR_ELT(res, 1, monthlyMin);
+
+ // Set mean maximum temperature
+ SET_VECTOR_ELT(res, 2, monthlyMax);
+
+ // Set mean annual precipitation (cm)
+ SET_VECTOR_ELT(res, 3, monthlyPPT);
+
+ // Set mean annual temperature (C)
+ SET_VECTOR_ELT(res, 4, MAP_cm);
+
+ // Set mean annual precipitation (cm)
+ SET_VECTOR_ELT(res, 5, MAT_C);
+
+ // Set values of the two standard deviation categories (C4 and cheatgrass)
+ // in result variable
+ SET_VECTOR_ELT(res, 8, C4Variables);
+ SET_VECTOR_ELT(res, 9, Cheatgrass);
+
+ deallocateClimateStructs(&climateOutput, &climateAverages);
+
+ UNPROTECT(12);
+
+ for(year = 0; year < numYears; year++) {
+ free(allHist[year]);
+ }
+ free(allHist);
+
+ return res;
- for (i = 0; i < days; i++) {
- doy = p_WTH_DATA[i + days * 0];
- if (doy < 1 || doy > days) {
- LogError(logfp, LOGFATAL, "weath.%4d : Day of year out of range, line %d.", year, lineno);
- }
-
- /* --- Make the assignments ---- */
- doy--;
-
- /* Reassign if invalid values are found. The values are
- * either valid or SW_MISSING. */
- j = i + days * 1;
- if (missing(p_WTH_DATA[j]) || ISNA(p_WTH_DATA[j])) {
- wh->temp_max[doy] = SW_MISSING;
- } else {
- wh->temp_max[doy] = p_WTH_DATA[j];
- }
-
- j = i + days * 2;
- if (missing(p_WTH_DATA[j]) || ISNA(p_WTH_DATA[j])) {
- wh->temp_min[doy] = SW_MISSING;
- } else {
- wh->temp_min[doy] = p_WTH_DATA[j];
- }
-
- j = i + days * 3;
- if (missing(p_WTH_DATA[j]) || ISNA(p_WTH_DATA[j])) {
- wh->ppt[doy] = SW_MISSING;
- } else {
- wh->ppt[doy] = p_WTH_DATA[j];
- has_values = TRUE;
- }
- } /* end of input lines */
-
- return has_values;
}
diff --git a/src/rSW_Weather.h b/src/rSW_Weather.h
index 2f7daba3..63272fef 100644
--- a/src/rSW_Weather.h
+++ b/src/rSW_Weather.h
@@ -1,11 +1,14 @@
-#include "SOILWAT2/Times.h"
+#include "SOILWAT2/include/Times.h"
+#include "SOILWAT2/include/SW_Weather.h"
#include // for SEXP
/* =================================================== */
/* Global Function Declarations */
/* --------------------------------------------------- */
-SEXP onGet_SW_WTH(void);
-void onSet_SW_WTH(SEXP SW_WTH);
+SEXP onGet_SW_WTH_setup(void);
+void onSet_SW_WTH_setup(SEXP SW_WTH);
SEXP onGet_WTH_DATA(void);
-Bool onSet_WTH_DATA_YEAR(TimeInt year);
+void onSet_WTH_DATA(void);
+SEXP rSW2_calc_SiteClimate(SEXP weatherList, SEXP yearStart, SEXP yearEnd,
+ SEXP do_C4vars, SEXP do_Cheatgrass_ClimVars, SEXP latitude);
diff --git a/tests/test_data/Ex1_input.rds b/tests/test_data/Ex1_input.rds
index 5f8b280c..7c0077a2 100644
Binary files a/tests/test_data/Ex1_input.rds and b/tests/test_data/Ex1_input.rds differ
diff --git a/tests/test_data/Ex1_output.rds b/tests/test_data/Ex1_output.rds
index 24e52bf1..318cbe68 100644
Binary files a/tests/test_data/Ex1_output.rds and b/tests/test_data/Ex1_output.rds differ
diff --git a/tests/test_data/Ex1_weather.rds b/tests/test_data/Ex1_weather.rds
index 1a2085a3..621d1933 100644
Binary files a/tests/test_data/Ex1_weather.rds and b/tests/test_data/Ex1_weather.rds differ
diff --git a/tests/test_data/Ex2_input.rds b/tests/test_data/Ex2_input.rds
index a41b1241..9003cd94 100644
Binary files a/tests/test_data/Ex2_input.rds and b/tests/test_data/Ex2_input.rds differ
diff --git a/tests/test_data/Ex2_weather.rds b/tests/test_data/Ex2_weather.rds
index 585dd1cb..1533bfe4 100644
Binary files a/tests/test_data/Ex2_weather.rds and b/tests/test_data/Ex2_weather.rds differ
diff --git a/tests/test_data/Ex3_input.rds b/tests/test_data/Ex3_input.rds
index ecb94ceb..3255bb9c 100644
Binary files a/tests/test_data/Ex3_input.rds and b/tests/test_data/Ex3_input.rds differ
diff --git a/tests/test_data/Ex3_output.rds b/tests/test_data/Ex3_output.rds
index b4c536ec..ef11ea11 100644
Binary files a/tests/test_data/Ex3_output.rds and b/tests/test_data/Ex3_output.rds differ
diff --git a/tests/test_data/Ex3_weather.rds b/tests/test_data/Ex3_weather.rds
index 1a2085a3..621d1933 100644
Binary files a/tests/test_data/Ex3_weather.rds and b/tests/test_data/Ex3_weather.rds differ
diff --git a/tests/test_data/Ex4_input.rds b/tests/test_data/Ex4_input.rds
index b9f018ef..b86f5734 100644
Binary files a/tests/test_data/Ex4_input.rds and b/tests/test_data/Ex4_input.rds differ
diff --git a/tests/test_data/Ex4_output.rds b/tests/test_data/Ex4_output.rds
index 11178d67..b8eb17ff 100644
Binary files a/tests/test_data/Ex4_output.rds and b/tests/test_data/Ex4_output.rds differ
diff --git a/tests/test_data/Ex4_weather.rds b/tests/test_data/Ex4_weather.rds
index 1a2085a3..621d1933 100644
Binary files a/tests/test_data/Ex4_weather.rds and b/tests/test_data/Ex4_weather.rds differ
diff --git a/tests/test_data/Ex5_input.rds b/tests/test_data/Ex5_input.rds
index 6a2b8c21..0c1f3c20 100644
Binary files a/tests/test_data/Ex5_input.rds and b/tests/test_data/Ex5_input.rds differ
diff --git a/tests/test_data/Ex5_output.rds b/tests/test_data/Ex5_output.rds
index 90d3b9c1..1b928093 100644
Binary files a/tests/test_data/Ex5_output.rds and b/tests/test_data/Ex5_output.rds differ
diff --git a/tests/test_data/Ex5_weather.rds b/tests/test_data/Ex5_weather.rds
index 1a2085a3..621d1933 100644
Binary files a/tests/test_data/Ex5_weather.rds and b/tests/test_data/Ex5_weather.rds differ
diff --git a/tests/test_data/Ex6_input.rds b/tests/test_data/Ex6_input.rds
index e65a10b0..d5ae0bd9 100644
Binary files a/tests/test_data/Ex6_input.rds and b/tests/test_data/Ex6_input.rds differ
diff --git a/tests/test_data/Ex6_output.rds b/tests/test_data/Ex6_output.rds
index 254bc1d5..1a9f12a9 100644
Binary files a/tests/test_data/Ex6_output.rds and b/tests/test_data/Ex6_output.rds differ
diff --git a/tests/test_data/Ex6_weather.rds b/tests/test_data/Ex6_weather.rds
index 8d1b14d9..621d1933 100644
Binary files a/tests/test_data/Ex6_weather.rds and b/tests/test_data/Ex6_weather.rds differ
diff --git a/tests/test_data/swp_values.rds b/tests/test_data/swp_values.rds
index ffe76c49..c492e894 100644
Binary files a/tests/test_data/swp_values.rds and b/tests/test_data/swp_values.rds differ
diff --git a/tests/test_data/versioned_swInputData/Ex1_input_v4.0.0.rds b/tests/test_data/versioned_swInputData/Ex1_input_v4.0.0.rds
new file mode 100644
index 00000000..d8a9895e
Binary files /dev/null and b/tests/test_data/versioned_swInputData/Ex1_input_v4.0.0.rds differ
diff --git a/tests/test_data/versioned_swInputData/Ex1_input_v5.2.0.rds b/tests/test_data/versioned_swInputData/Ex1_input_v5.2.0.rds
new file mode 100644
index 00000000..9e5faf6d
Binary files /dev/null and b/tests/test_data/versioned_swInputData/Ex1_input_v5.2.0.rds differ
diff --git a/tests/test_data/versioned_swInputData/Ex1_input_v5.3.1.rds b/tests/test_data/versioned_swInputData/Ex1_input_v5.3.1.rds
new file mode 100644
index 00000000..b05d9159
Binary files /dev/null and b/tests/test_data/versioned_swInputData/Ex1_input_v5.3.1.rds differ
diff --git a/tests/test_data/versioned_swInputData/Ex1_input_v6.0.0.rds b/tests/test_data/versioned_swInputData/Ex1_input_v6.0.0.rds
new file mode 100644
index 00000000..7c0077a2
Binary files /dev/null and b/tests/test_data/versioned_swInputData/Ex1_input_v6.0.0.rds differ
diff --git a/tests/test_data/versioned_weatherData/Ex1_weather_v4.0.0.rds b/tests/test_data/versioned_weatherData/Ex1_weather_v4.0.0.rds
new file mode 100644
index 00000000..82978781
Binary files /dev/null and b/tests/test_data/versioned_weatherData/Ex1_weather_v4.0.0.rds differ
diff --git a/tests/test_data/versioned_weatherData/Ex1_weather_v6.0.0.rds b/tests/test_data/versioned_weatherData/Ex1_weather_v6.0.0.rds
new file mode 100644
index 00000000..621d1933
Binary files /dev/null and b/tests/test_data/versioned_weatherData/Ex1_weather_v6.0.0.rds differ
diff --git a/tests/testthat/test_DataAccess.R b/tests/testthat/test_DataAccess.R
index 9b74c1b0..d9c413b5 100644
--- a/tests/testthat/test_DataAccess.R
+++ b/tests/testthat/test_DataAccess.R
@@ -1,5 +1,3 @@
-context("rSOILWAT2 data access functions")
-
#--- Tests
test_that("set_requested_flags:", {
diff --git a/tests/testthat/test_OutputDerived.R b/tests/testthat/test_OutputDerived.R
index 9c0d9797..62b8570c 100644
--- a/tests/testthat/test_OutputDerived.R
+++ b/tests/testthat/test_OutputDerived.R
@@ -1,25 +1,80 @@
-context("Derived output functions")
-
# Tests
test_that("Derived output: transpiration and evaporation", {
sw_in <- rSOILWAT2::sw_exampleData
- # With 'AET' output activated
+ tp <- "Month"
+
+ icols <- time_columns(tp)
+
+ #--- With 'AET' output activated
sw_out1 <- sw_exec(inputData = sw_in)
- tran1 <- get_transpiration(sw_out1, "Month")
- evap1 <- get_evaporation(sw_out1, "Month")
+ tran1 <- get_transpiration(sw_out1, timestep = tp)
+ evap1 <- get_evaporation(sw_out1, timestep = tp)
+
+
+ #--- Request time information
+ # -> Output should be the same either way
+ expect_equal(
+ get_transpiration(
+ sw_out1,
+ timestep = tp,
+ keep_time = TRUE
+ )[, -icols, drop = TRUE],
+ tran1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
+
+ expect_equal(
+ get_evaporation(
+ sw_out1,
+ timestep = tp,
+ keep_time = TRUE
+ )[, -icols, drop = TRUE],
+ evap1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
- # De-activate 'AET' output and re-calculated from 'TRANSP'
+
+ #--- De-activate 'AET' output and re-calculated from 'TRANSP'
+ # -> Output should be the same either way
deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()["sw_aet"]
sw_out2 <- sw_exec(inputData = sw_in)
- tran2 <- get_transpiration(sw_out2, "Month")
- evap2 <- get_evaporation(sw_out2, "Month")
+
+ expect_equal(
+ get_transpiration(sw_out2, timestep = tp),
+ tran1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
+
+ expect_equal(
+ get_evaporation(sw_out2, timestep = tp),
+ evap1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
- # Output should be the same either way
- expect_equal(tran1, tran2)
- expect_equal(evap1, evap2)
+ #--- Request time information
+ # -> Output should be the same either way
+ expect_equal(
+ get_transpiration(
+ sw_out2,
+ timestep = tp,
+ keep_time = TRUE
+ )[, -icols, drop = TRUE],
+ tran1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
+
+ expect_equal(
+ get_evaporation(
+ sw_out2,
+ timestep = tp,
+ keep_time = TRUE
+ )[, -icols, drop = TRUE],
+ evap1,
+ tolerance = rSW2_glovars[["tol"]]
+ )
})
@@ -27,14 +82,15 @@ test_that("Derived output: soil/surface temperature", {
sw_in <- rSOILWAT2::sw_exampleData
n_soillayers <- nrow(swSoils_Layers(sw_in))
req_levels <- c("min", "avg", "max")
+ tp <- "Month"
#--- 'SOILTEMP' output de-activated
# Expect error only if such output requested
sw_indeact <- sw_in
deactivate_swOUT_OutKey(sw_indeact) <- sw_out_flags()["sw_soiltemp"]
sw_out <- sw_exec(inputData = sw_indeact)
- expect_error(get_soiltemp(sw_out, "Month"))
- expect_silent(get_soiltemp(sw_out, "Month", soillayers = NA))
+ expect_error(get_soiltemp(sw_out, timestep = tp))
+ expect_silent(get_soiltemp(sw_out, timestep = tp, soillayers = NA))
#--- 'TEMP' output de-activated
@@ -42,8 +98,10 @@ test_that("Derived output: soil/surface temperature", {
sw_indeact <- sw_in
deactivate_swOUT_OutKey(sw_indeact) <- sw_out_flags()["sw_temp"]
sw_out <- sw_exec(inputData = sw_indeact)
- expect_error(get_soiltemp(sw_out, "Month"))
- expect_silent(get_soiltemp(sw_out, "Month", surface = FALSE, soillayers = 1))
+ expect_error(get_soiltemp(sw_out, timestep = tp))
+ expect_silent(
+ get_soiltemp(sw_out, timestep = tp, surface = FALSE, soillayers = 1L)
+ )
#--- All simulation output activated
@@ -52,7 +110,7 @@ test_that("Derived output: soil/surface temperature", {
# All output turned off
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = FALSE,
soillayers = NA
@@ -66,10 +124,10 @@ test_that("Derived output: soil/surface temperature", {
# All output turned off or non-existing soil layers requested
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = FALSE,
- soillayers = c(-1, 999)
+ soillayers = c(-1L, 999L)
)
for (lvl in req_levels) {
@@ -81,20 +139,34 @@ test_that("Derived output: soil/surface temperature", {
# Expect surface soil temperature: `surface`
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = TRUE
)
for (lvl in req_levels) {
- expect_match(colnames(st[[lvl]])[1], "surfaceTemp")
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_match(colnames(st[[lvl]])[1L], "surfaceTemp")
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
+ }
+
+ # Including time step values
+ st <- get_soiltemp(
+ sw_out,
+ timestep = tp,
+ levels = req_levels,
+ surface = TRUE,
+ keep_time = TRUE
+ )
+
+ for (lvl in req_levels) {
+ expect_match(colnames(st[[lvl]])[1L + max(time_columns(tp))], "surfaceTemp")
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
}
# Expect surface soil temperature: `soillayers` include 0
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = FALSE,
soillayers = 0
@@ -102,14 +174,14 @@ test_that("Derived output: soil/surface temperature", {
for (lvl in req_levels) {
expect_match(colnames(st[[lvl]])[1], "surfaceTemp")
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
}
# Expect soil temperature: all soil layers: `soillayers` is `NULL`
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
surface = FALSE,
levels = req_levels,
soillayers = NULL
@@ -117,22 +189,40 @@ test_that("Derived output: soil/surface temperature", {
for (lvl in req_levels) {
expect_match(colnames(st[[lvl]]), "Lyr")
- expect_equal(ncol(st[[lvl]]), n_soillayers)
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_identical(ncol(st[[lvl]]), n_soillayers)
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
}
+ # Including time step values
+ st <- get_soiltemp(
+ sw_out,
+ timestep = tp,
+ surface = FALSE,
+ levels = req_levels,
+ soillayers = NULL,
+ keep_time = TRUE
+ )
+
+ icols <- time_columns(tp)
+ for (lvl in req_levels) {
+ expect_match(colnames(st[[lvl]])[-icols], "Lyr")
+ expect_identical(ncol(st[[lvl]]), length(icols) + n_soillayers)
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
+ }
+
+
# Expect soil temperature: no soil layers: `soillayers` is `NA`
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
surface = TRUE,
levels = req_levels,
soillayers = NA
)
for (lvl in req_levels) {
- expect_equal(ncol(st[[lvl]]), 1)
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_identical(ncol(st[[lvl]]), 1L)
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
}
@@ -140,7 +230,7 @@ test_that("Derived output: soil/surface temperature", {
req_sl <- c(1, 3:4)
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = FALSE,
soillayers = req_sl
@@ -148,8 +238,8 @@ test_that("Derived output: soil/surface temperature", {
for (lvl in req_levels) {
expect_match(colnames(st[[lvl]]), "Lyr")
- expect_equal(ncol(st[[lvl]]), length(req_sl))
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_identical(ncol(st[[lvl]]), length(req_sl))
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
}
@@ -157,7 +247,7 @@ test_that("Derived output: soil/surface temperature", {
req_sl <- c(1, 3:4, 999)
st <- get_soiltemp(
sw_out,
- timestep = "Month",
+ timestep = tp,
levels = req_levels,
surface = FALSE,
soillayers = req_sl
@@ -166,6 +256,126 @@ test_that("Derived output: soil/surface temperature", {
for (lvl in req_levels) {
expect_match(colnames(st[[lvl]]), "Lyr")
expect_lt(ncol(st[[lvl]]), length(req_sl))
- expect_equal(nrow(st[[lvl]]), slot(sw_out, "mo_nrow"))
+ expect_identical(nrow(st[[lvl]]), nrow_output(sw_out, tp))
+ }
+})
+
+
+test_that("Derived output: soil moisture", {
+ timesteps <- c("Day", "Week", "Month", "Year")
+ types <- c(
+ sw_swcbulk = "swc",
+ sw_vwcbulk = "vwc_bulk",
+ sw_vwcmatric = "vwc_matric"
+ )
+
+ sw_in <- rSOILWAT2::sw_exampleData
+ n_soillayers <- nrow(swSoils_Layers(sw_in))
+ widths_cm <- diff(c(0., swSoils_Layers(sw_in)[, "depth_cm"]))
+ fcoarse <- swSoils_Layers(sw_in)[, "gravel_content"]
+
+ # Loop over `keep_time`
+ for (kt in c(TRUE, FALSE)) {
+
+ # Loop over time steps
+ for (tp in timesteps) {
+ #--- Requested soil moisture directly available
+ sw_out <- sw_exec(inputData = sw_in)
+ res0 <- lapply(
+ types,
+ function(type) {
+ get_soilmoisture(sw_out, timestep = tp, type = type, keep_time = kt)
+ }
+ )
+
+ for (k1 in seq_along(types)) {
+ # Expect that columns represent soil layers and rows time steps
+ expect_identical(
+ ncol(res0[[k1]]),
+ n_soillayers + if (kt) length(time_columns(tp)) else 0L
+ )
+ expect_identical(nrow(res0[[k1]]), nrow_output(sw_out, tp))
+ }
+
+
+ #--- Convert soil moisture among swc, vwc_bulk, and vwc_matric
+ for (k2 in seq_along(types)) {
+ sw_in1 <- sw_in
+ # turn off the other soil moisture types
+ for (k3 in seq_along(types)[-k2]) {
+ deactivate_swOUT_OutKey(sw_in1) <-
+ sw_out_flags()[[names(types)[[k3]]]]
+ }
+ sw_out <- sw_exec(inputData = sw_in1)
+
+ #--- Derive soil information from `swInput`
+ res1 <- lapply(
+ types,
+ function(type) {
+ get_soilmoisture(
+ sw_out,
+ timestep = tp,
+ type = type,
+ swInput = sw_in1,
+ keep_time = kt
+ )
+ }
+ )
+
+ for (k1 in seq_along(types)) {
+ # Expect that calculated moisture is (almost) equal to direct version
+ expect_equal(
+ res1[[k1]],
+ res0[[k1]],
+ tolerance = sqrt(.Machine[["double.eps"]])
+ )
+ }
+
+ #--- Derive soil information from `widths_cm` and `fcoarse`
+ res2 <- lapply(
+ types,
+ function(type) {
+ get_soilmoisture(
+ sw_out,
+ timestep = tp,
+ type = type,
+ widths_cm = widths_cm,
+ fcoarse = fcoarse,
+ keep_time = kt
+ )
+ }
+ )
+
+ for (k1 in seq_along(types)) {
+ # Expect that calculated moisture is (almost) equal to direct version
+ expect_equal(
+ res2[[k1]],
+ res0[[k1]],
+ tolerance = sqrt(.Machine[["double.eps"]])
+ )
+ }
+
+ #--- Expect error if calculation does not have enough soil information
+ expect_error(
+ get_soilmoisture(sw_out, timestep = tp, type = type)
+ )
+ expect_error(
+ get_soilmoisture(
+ sw_out,
+ timestep = tp,
+ type = type,
+ widths_cm = widths_cm
+ )
+ )
+ expect_error(
+ get_soilmoisture(
+ sw_out,
+ timestep = to,
+ type = type,
+ fcoarse = fcoarse
+ )
+ )
+ }
+ }
}
})
diff --git a/tests/testthat/test_SegmentationFault_v3.R b/tests/testthat/test_SegmentationFault_v3.R
index 7015e657..d91613e0 100644
--- a/tests/testthat/test_SegmentationFault_v3.R
+++ b/tests/testthat/test_SegmentationFault_v3.R
@@ -1,4 +1,3 @@
-context("rSOILWAT2 segfault")
# nolint start: line_length_linter, commented_code_linter.
# Running from command line --> segfaults
@@ -15,20 +14,24 @@ context("rSOILWAT2 segfault")
#gctorture(FALSE) #https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Using-gctorture
# nolint end
-# Create reference objects
-path_demo <- system.file("extdata", "example1", package = "rSOILWAT2")
-a <- sw_inputDataFromFiles(dir = path_demo,
- files.in = file.path(path_demo, "files.in"))
+test_that("Test for segfault", {
+ # Create reference objects
+ path_demo <- system.file("extdata", "example1", package = "rSOILWAT2")
+
+ a <- sw_inputDataFromFiles(
+ dir = path_demo,
+ files.in = file.path(path_demo, "files.in")
+ )
+
+ # Location of segfaults with upper bound of b
+ # - (eo/debug/!interactive()): step 2 >= 558151 > step 3 >= 558105 >
+ # step 4 >= 555193 > no segfault
+ b <- 1:1e6
+ b2 <- 1:1e7
+ b3 <- 1:1e7
-# Location of segfaults with upper bound of b
-# - (eo/debug/!interactive()): step 2 >= 558151 > step 3 >= 558105 >
-# step 4 >= 555193 > no segfault
-b <- 1:1e6
-b2 <- 1:1e7
-b3 <- 1:1e7
-test_that("Test for segfault", {
expect_silent({
elems <- ls(envir = .GlobalEnv)
if (length(elems) > 0) for (i in seq_along(elems)) x <- get(elems[i])
diff --git a/tests/testthat/test_Soils.R b/tests/testthat/test_Soils.R
index c350d4d6..0f2993b9 100644
--- a/tests/testthat/test_Soils.R
+++ b/tests/testthat/test_Soils.R
@@ -1,4 +1,3 @@
-context("Manipulate soil")
test_that("Manipulate soils", {
diff --git a/tests/testthat/test_Upgrade_rSOILWAT_S4_classes.R b/tests/testthat/test_Upgrade_rSOILWAT_S4_classes.R
new file mode 100644
index 00000000..4208a887
--- /dev/null
+++ b/tests/testthat/test_Upgrade_rSOILWAT_S4_classes.R
@@ -0,0 +1,63 @@
+
+
+#--- Maintenance inputs ------
+# Copy "Ex1_input.rds" to "versioned_swInputData/" (with updated name)
+# if significant changes occurred.
+
+test_that("Upgrade old rSOILWAT2 input objects", {
+ #--- Locate versioned `swInputData` objects
+ dir_test_data <- file.path("..", "test_data", "versioned_swInputData")
+ fnames_vdata <- list.files(
+ dir_test_data,
+ pattern = "Ex1_input_v",
+ full.names = TRUE
+ )
+
+ expect_gt(length(fnames_vdata), 0L)
+
+
+ # Upgrade `swInputData`
+ for (k in seq_along(fnames_vdata)) {
+ xold <- readRDS(fnames_vdata[k])
+
+ if (!suppressWarnings(check_version(xold))) {
+ expect_error(validObject(xold))
+ }
+
+ expect_true(validObject(sw_upgrade(xold)))
+ }
+})
+
+
+
+#--- Maintenance weather ------
+# Copy "Ex1_weather.rds" to "versioned_weatherData/" (with updated name)
+# if significant changes occurred.
+
+test_that("Upgrade old rSOILWAT2 weather objects", {
+ #--- Locate versioned `weatherData` objects
+ dir_test_data <- file.path("..", "test_data", "versioned_weatherData")
+ fnames_vdata <- list.files(
+ dir_test_data,
+ pattern = "Ex1_weather_v",
+ full.names = TRUE
+ )
+
+ tmp <- gsub("Ex1_weather_v", "", basename(fnames_vdata), fixed = TRUE)
+ tmp <- gsub(".rds", "", tmp, fixed = TRUE)
+ vs <- as.numeric_version(tmp)
+
+ expect_gt(length(fnames_vdata), 0L)
+
+
+ # Upgrade weather data, i.e., lists of class `swWeatherData`
+ for (k in seq_along(fnames_vdata)) {
+ x <- readRDS(fnames_vdata[k])
+
+ if (!check_version(vs[k])) {
+ expect_false(dbW_check_weatherData(x))
+ }
+
+ expect_true(dbW_check_weatherData(upgrade_weatherHistory(x)))
+ }
+})
diff --git a/tests/testthat/test_Vegetation.R b/tests/testthat/test_Vegetation.R
index dbd524de..4f350329 100644
--- a/tests/testthat/test_Vegetation.R
+++ b/tests/testthat/test_Vegetation.R
@@ -1,4 +1,3 @@
-context("Vegetation functions")
# Inputs
utils::data("weatherData", package = "rSOILWAT2")
@@ -6,7 +5,7 @@ clim <- calc_SiteClimate(
weatherList = weatherData,
year.start = 1949,
year.end = 2010,
- do_C4vars = FALSE,
+ do_C4vars = TRUE,
simTime2 = NULL
)
@@ -86,7 +85,7 @@ test_that("Vegetation: estimate land cover composition", {
)
expect_pnv(pnv)
- expect_equal(pnv, pnv0_expected)
+ expect_equal(pnv, pnv0_expected, tolerance = 1e-6)
# The set land cover types are 0
for (k in iset) {
@@ -94,6 +93,37 @@ test_that("Vegetation: estimate land cover composition", {
}
+ #--- SOILWAT2 uses the same algorithm internally if requested to do so ------
+ # Obtain cover values from SOILWAT2 output
+ swin <- rSOILWAT2::sw_exampleData
+ swin@prod@veg_method <- 1L
+ swout <- sw_exec(swin)
+ tmp <- slot(slot(swout, "BIOMASS"), "Year")
+ pnvsim <- tmp[1, grep("fCover", colnames(tmp), fixed = TRUE), drop = TRUE]
+
+ # Directly calculate cover values
+ climex <- calc_SiteClimate(weatherList = get_WeatherHistory(swin))
+ pnvex <- estimate_PotNatVeg_composition(
+ MAP_mm = 10 * climex[["MAP_cm"]],
+ MAT_C = climex[["MAT_C"]],
+ mean_monthly_ppt_mm = 10 * climex[["meanMonthlyPPTcm"]],
+ mean_monthly_Temp_C = climex[["meanMonthlyTempC"]]
+ )[["Rel_Abundance_L1"]]
+
+ # Expect them to be identical
+ tol <- sqrt(.Machine[["double.eps"]])
+ expect_equal(pnvsim[["fCover_shrub"]], pnvex[["SW_SHRUB"]], tolerance = tol)
+ expect_equal(pnvsim[["fCover_grass"]], pnvex[["SW_GRASS"]], tolerance = tol)
+ expect_equal(pnvsim[["fCover_forbs"]], pnvex[["SW_FORBS"]], tolerance = tol)
+ expect_equal(pnvsim[["fCover_tree"]], pnvex[["SW_TREES"]], tolerance = tol)
+ expect_equal(
+ pnvsim[["fCover_BareGround"]],
+ pnvex[["SW_BAREGROUND"]],
+ tolerance = tol
+ )
+
+
+
#--- Some land cover types are fixed and others are estimated:
Shrubs_Fraction <- 0.5
BareGround_Fraction <- 0.25
@@ -218,6 +248,32 @@ test_that("Vegetation: estimate land cover composition", {
)
}
+
+ # issue 218: correction to C4 grass cover was not carried out as documented
+ # without C4 correction, C4 grass cover was 0.1166967
+ res_wo218 <- estimate_PotNatVeg_composition(
+ MAP_mm = 10 * clim[["MAP_cm"]],
+ MAT_C = 15,
+ mean_monthly_ppt_mm = 10 * clim[["meanMonthlyPPTcm"]],
+ mean_monthly_Temp_C = 5 + clim[["meanMonthlyTempC"]],
+ dailyC4vars = NULL
+ )
+ expect_gt(res_wo218[["Rel_Abundance_L0"]][["Grasses_C4"]], 0)
+
+ res_w218 <- estimate_PotNatVeg_composition(
+ MAP_mm = 10 * clim[["MAP_cm"]],
+ MAT_C = 15,
+ mean_monthly_ppt_mm = 10 * clim[["meanMonthlyPPTcm"]],
+ mean_monthly_Temp_C = 5 + clim[["meanMonthlyTempC"]],
+ dailyC4vars = c(
+ Month7th_NSadj_MinTemp_C = 5,
+ LengthFreezeFreeGrowingPeriod_NSadj_Days = 150,
+ DegreeDaysAbove65F_NSadj_DaysC = 110
+ )
+ )
+ expect_equal(res_w218[["Rel_Abundance_L0"]][["Grasses_C4"]], 0)
+
+
#--- The function `estimate_PotNatVeg_composition` can fail under a few
# situations:
# (i) fixed sum is more than 1
@@ -231,6 +287,23 @@ test_that("Vegetation: estimate land cover composition", {
)
)
+ # issue 219: output incorrectly contained negative cover
+ # if fixed `SumGrasses_Fraction` caused that other fixed cover summed > 1
+ # correct behavior is error
+ expect_error(
+ estimate_PotNatVeg_composition(
+ MAP_mm = 10 * clim[["MAP_cm"]],
+ MAT_C = clim[["MAT_C"]],
+ mean_monthly_ppt_mm = 10 * clim[["meanMonthlyPPTcm"]],
+ mean_monthly_Temp_C = clim[["meanMonthlyTempC"]],
+ dailyC4vars = clim[["dailyC4vars"]],
+ fix_shrubs = TRUE,
+ Shrubs_Fraction = 0.5,
+ fix_sumgrasses = TRUE,
+ SumGrasses_Fraction = 0.7
+ )
+ )
+
# (ii) all fixed but sum is less than 1 and !fill_empty_with_BareGround
expect_error(
estimate_PotNatVeg_composition(
@@ -250,19 +323,6 @@ test_that("Vegetation: estimate land cover composition", {
)
)
- # converted from error into warning:
- # (iii) cover to estimate is 0, fixed types are less than 1, and bare-ground
- # is fixed
- expect_warning(
- estimate_PotNatVeg_composition(
- MAP_mm = 900,
- MAT_C = -10,
- mean_monthly_ppt_mm = c(0, 0, rep(100, 9), 0),
- mean_monthly_Temp_C = rep(-10, 12),
- fill_empty_with_BareGround = FALSE
- )
- )
-
# The last errors are avoided if `fill_empty_with_BareGround = TRUE`
# and bare-ground is not fixed; we get 100% bare-ground cover
expect_silent(
@@ -283,7 +343,25 @@ test_that("Vegetation: estimate land cover composition", {
)
expect_pnv(pnv[1:2])
- expect_equivalent(pnv[["Rel_Abundance_L0"]][ibar], 1)
+ expect_equal(pnv[["Rel_Abundance_L0"]][ibar], 1, ignore_attr = "names")
+
+ # Make sure `SOILWAT2` throws a warning that R, we use `sw_verbosity()`
+ # to do that
+ prev_quiet <- sw_verbosity(TRUE)
+
+ # Expecting warning because MAT_C is outside of formulas domain
+ expect_warning(
+ estimate_PotNatVeg_composition(
+ MAP_mm = 900,
+ MAT_C = -10,
+ mean_monthly_ppt_mm = c(0, 0, rep(100, 9), 0),
+ mean_monthly_Temp_C = rep(-10, 12),
+ fill_empty_with_BareGround = FALSE
+ )
+ )
+
+ # Undo what the previous call to `sw_verbosity()` did
+ sw_verbosity(prev_quiet)
})
@@ -298,7 +376,7 @@ test_that("Vegetation: adjust phenology", {
swProd_MonProd_tree(sw_exampleData)
)
- phen_in <- lapply(phen_in, as.data.frame)
+ phen_in <- lapply(phen_in, function(x) as.data.frame(x))
clim <- calc_SiteClimate(weatherList = rSOILWAT2::weatherData)
ref_temp <- clim[["meanMonthlyTempC"]]
diff --git a/tests/testthat/test_WaterBalance.R b/tests/testthat/test_WaterBalance.R
index 1b060842..0df88025 100644
--- a/tests/testthat/test_WaterBalance.R
+++ b/tests/testthat/test_WaterBalance.R
@@ -1,4 +1,3 @@
-context("rSOILWAT2 water balance")
# The 8 checks, implemented below, correspond to the checks in
# \var{SOILWAT/test/test_WaterBalance.cc}
@@ -7,13 +6,28 @@ context("rSOILWAT2 water balance")
#---CONSTANTS
tol <- 10 ^ (-rSW2_glovars[["kSOILWAT2"]][["kINT"]][["OUT_DIGITS"]])
SW_OUTNPERIODS <- rSW2_glovars[["kSOILWAT2"]][["kINT"]][["SW_OUTNPERIODS"]]
-OutPeriods <- rSW2_glovars[["sw_TimeSteps"]]
+OutPeriods <- rSW2_glovars[["kSOILWAT2"]][["OutPeriods"]]
veg_types <- c("tree", "shrub", "forbs", "grass")
dir_test_data <- file.path("..", "test_data")
temp <- list.files(dir_test_data, pattern = "Ex")
temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(temp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
+
+
+# List of (available) SWRC-PTF combinations
+list_swrcs_ptfs <- unname(as.list(as.data.frame(t(
+ rSOILWAT2::list_matched_swrcs_ptfs()
+))))
+
+tmp <- check_ptf_availability(
+ sapply(list_swrcs_ptfs, `[`, j = 2),
+ verbose = FALSE
+)
+list_swrcs_ptfs <- list_swrcs_ptfs[tmp]
+
aggregate_for_each_timestep <- function(x, dyt) {
nid <- 1:2
@@ -40,230 +54,289 @@ aggregate_for_each_timestep <- function(x, dyt) {
}
+#--- Loop over test cases ------
for (it in tests) {
#---INPUTS
sw_weather <- readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
sw_input <- readRDS(file.path(dir_test_data, paste0(it, "_input.rds")))
+
+
# Request summed values for every time step
+ # but turn off SWP (because summed VWC may be larger than theta_sat)
+ deactivate_swOUT_OutKey(sw_input) <- rSOILWAT2::sw_out_flags()["sw_swp"]
+
swOUT_TimeStepsForEveryKey(sw_input) <- seq_len(SW_OUTNPERIODS) - 1
slot(slot(sw_input, "output"), "sumtype")[] <- 1L
- #---TESTS
- info1 <- paste("test-data:", it)
- test_that("Water balance & cycle", {
- # Run SOILWAT
- x <- sw_exec(
- inputData = sw_input,
- weatherList = sw_weather,
- echo = FALSE,
- quiet = TRUE
- )
- expect_s4_class(x, "swOutput")
-
-
- # Get state change values which are directly re-aggregated from daily data
- N <- slot(x, "dy_nrow")
- Ns <- seq_len(N)
- idelta1 <- Ns[-N]
- idelta2 <- Ns[-1]
-
- temp <- slot(slot(x, "SURFACEWATER"), "Day")
- surfaceWater <- temp[, "surfaceWater_cm"]
-
- dates <- data.frame(temp[, c("Year", "Day")])
- dates[, "DOY"] <- dates[, "Day"]
- temp <- as.POSIXlt(seq.Date(
- from = as.Date(ISOdate(dates[1, "Year"], 1, 1)),
- to = as.Date(ISOdate(dates[nrow(dates), "Year"], 12, 31)),
- by = "day"
- ))
- dates[, "Month"] <- 1 + temp$mon
- dates[, "Day"] <- temp$mday
- # SOILWAT2 'weeks' are not calendar weeks as in
- # \code{as.integer(format(temp, "%W"))}
- # with \code{%U = US weeks}; \coe{%V = ISO 8601}; \code{%W = UK weeks}
- # instead SOILWAT2 numbers consecutive sets of 7-day periods
- dates[, "Week"] <- 1 + (dates[, "DOY"] - 1) %/% 7
- dyt <- list(
- d = dates,
- ids1 = idelta1,
- ids2 = idelta2,
- # not first year:
- nfy = which(temp <- dates[, "Year"] != dates[1, "Year"]),
- # not first month of first year:
- nfm = which(temp | dates[, "Month"] != dates[1, "Month"]),
- # not first week of first year:
- nfw = which(temp | dates[, "Week"] != dates[1, "Week"])
- )
+ #--- Loop over SWRC-PTF combinations ------
+ for (isp in seq_along(list_swrcs_ptfs)) {
+ # Set SWRC/PTF
+ rSOILWAT2::swSite_SWRCflags(sw_input) <- list_swrcs_ptfs[[isp]]
- # change in ponded (surface) water
- list_delta_surfaceWater <- aggregate_for_each_timestep(
- x = surfaceWater[dyt[["ids2"]]] - surfaceWater[dyt[["ids1"]]],
- dyt = dyt
- )
- # change in soil moisture
- temp <- slot(slot(x, "SWCBULK"), "Day")
- swcj <- temp[, grep("Lyr", colnames(temp), fixed = TRUE), drop = FALSE]
- n_soillayers <- ncol(swcj)
-
- # today - yesterday:
- dy_delta_swcj <- swcj[dyt[["ids2"]], ] - swcj[dyt[["ids1"]], ]
- list_delta_swcj <- aggregate_for_each_timestep(x = dy_delta_swcj, dyt)
- list_delta_swc_total <- aggregate_for_each_timestep(
- x = apply(dy_delta_swcj, 1, sum),
- dyt = dyt
+ #---TESTS
+ info1 <- paste(
+ "test-data:", it, "/",
+ paste(list_swrcs_ptfs[[isp]], collapse = "-")
)
+ test_that("Water balance & cycle", {
+ # Run SOILWAT (but some PTFs require live internet!)
+ x <- try(
+ sw_exec(
+ inputData = sw_input,
+ weatherList = sw_weather,
+ echo = FALSE,
+ quiet = TRUE
+ ),
+ silent = TRUE
+ )
+
+ if (inherits(x, "try-error")) {
+ # Skip if it failed because PTF requires internet but we are offline
+ if (isTRUE(grepl("requires live internet", x, fixed = TRUE))) {
+ succeed(paste(info1, "requires live internet, skipping for now!"))
+ } else {
+ fail(paste(info1, x))
+ }
+
+ } else {
+
+ expect_s4_class(x, "swOutput")
+
+
+ # State change values which are directly re-aggregated from daily data
+ N <- slot(x, "dy_nrow")
+ Ns <- seq_len(N)
+ idelta1 <- Ns[-N]
+ idelta2 <- Ns[-1]
+
+ temp <- slot(slot(x, "SURFACEWATER"), "Day")
+ surfaceWater <- temp[, "surfaceWater_cm"]
+
+ dates <- data.frame(temp[, c("Year", "Day")])
+ dates[, "DOY"] <- dates[, "Day"]
+ temp <- as.POSIXlt(seq.Date(
+ from = as.Date(ISOdate(dates[1, "Year"], 1, 1)),
+ to = as.Date(ISOdate(dates[nrow(dates), "Year"], 12, 31)),
+ by = "day"
+ ))
+ dates[, "Month"] <- 1 + temp$mon
+ dates[, "Day"] <- temp$mday
+ # SOILWAT2 'weeks' are not calendar weeks as in
+ # \code{as.integer(format(temp, "%W"))}
+ # with \code{%U = US weeks}; \coe{%V = ISO 8601}; \code{%W = UK weeks}
+ # instead SOILWAT2 numbers consecutive sets of 7-day periods
+ dates[, "Week"] <- 1 + (dates[, "DOY"] - 1) %/% 7
+ dyt <- list(
+ d = dates,
+ ids1 = idelta1,
+ ids2 = idelta2,
+ # not first year:
+ nfy = which(temp <- dates[, "Year"] != dates[1, "Year"]),
+ # not first month of first year:
+ nfm = which(temp | dates[, "Month"] != dates[1, "Month"]),
+ # not first week of first year:
+ nfw = which(temp | dates[, "Week"] != dates[1, "Week"])
+ )
+
+ # change in ponded (surface) water
+ list_delta_surfaceWater <- aggregate_for_each_timestep(
+ x = surfaceWater[dyt[["ids2"]]] - surfaceWater[dyt[["ids1"]]],
+ dyt = dyt
+ )
+
+ # change in soil moisture
+ temp <- slot(slot(x, "SWCBULK"), "Day")
+ swcj <- temp[, grep("Lyr", colnames(temp), fixed = TRUE), drop = FALSE]
+ n_soillayers <- ncol(swcj)
+
+ # today - yesterday:
+ dy_delta_swcj <- swcj[dyt[["ids2"]], ] - swcj[dyt[["ids1"]], ]
+ list_delta_swcj <- aggregate_for_each_timestep(x = dy_delta_swcj, dyt)
+ list_delta_swc_total <- aggregate_for_each_timestep(
+ x = apply(dy_delta_swcj, 1, sum),
+ dyt = dyt
+ )
+
+
+ # Loop through time steps
+ for (pd in seq_len(SW_OUTNPERIODS)) {
+ info2 <- paste(info1, "/ time step:", OutPeriods[pd])
+
+ # Get values
+ ets <- slot(slot(x, "AET"), OutPeriods[pd])
+ aet <- ets[, "evapotr_cm"]
+ pet <- slot(slot(x, "PET"), OutPeriods[pd])[, "pet_cm"]
+
+ temp <- seq_along(aet)
+ idelta1 <- temp[-length(temp)]
+ idelta2 <- temp[-1]
+
+ # Get evaporation values
+ temp <- slot(slot(x, "EVAPSURFACE"), OutPeriods[pd])
+ Etotalsurf <- temp[, "evap_total"]
+ Elitter <- temp[, "evap_litter"]
+ Eponded <- temp[, "evap_surfaceWater"]
+ Evegi <- temp[, paste0("evap_", veg_types), drop = FALSE]
+ Eveg <- apply(Evegi, 1, sum)
+ Etotalint <- Eveg + Elitter
+
+ temp <- slot(slot(x, "EVAPSOIL"), OutPeriods[pd])
+ ids <- grep("Lyr", colnames(temp), fixed = TRUE)
+ Esoilj <- temp[, ids, drop = FALSE]
+ Esoil <- apply(Esoilj, 1, sum)
+
+ temp <- matrix(0, nrow = nrow(Esoilj), ncol = n_soillayers)
+ temp[, seq_len(ncol(Esoilj))] <- Esoilj
+ Esoilj <- temp
+
+ Esnow <- slot(slot(x, "PRECIP"), OutPeriods[pd])[, "snowloss"]
+ Etotal <- Etotalsurf + Esoil + Esnow
+
+ # Get transpiration values
+ temp <- slot(slot(x, "TRANSP"), OutPeriods[pd])
+ ids <- grep("transp_total_Lyr", colnames(temp), fixed = TRUE)
+ Ttotalj <- temp[, ids, drop = FALSE]
+ Ttotal <- apply(Ttotalj, 1, sum)
+ Tvegij <- lapply(
+ veg_types,
+ function(v) {
+ ids <- grep(
+ paste0("transp_", v, "_Lyr"),
+ colnames(temp),
+ fixed = TRUE
+ )
+ temp[, ids, drop = FALSE]
+ }
+ )
+ names(Tvegij) <- veg_types
+
+
+ #--- Check that calculated transpiration and evaporation matches
+ # newly available ones from "AET" slot
+ expect_equal(Ttotal, ets[, "tran_cm"], tolerance = tol)
+ expect_equal(Esoil, ets[, "esoil_cm"], tolerance = tol)
+ expect_equal(Esnow, ets[, "esnow_cm"], tolerance = tol)
+ expect_equal(Eveg, ets[, "ecnw_cm"], tolerance = tol)
+ expect_equal(Eponded + Elitter, ets[, "esurf_cm"], tolerance = tol)
+
+ tmp_evars2 <- c("esoil_cm", "ecnw_cm", "esurf_cm", "esnow_cm")
+ Etotal2 <- apply(ets[, tmp_evars2], 1, sum)
+ expect_equal(Etotal, Etotal2, tolerance = tol)
+ expect_equal(aet, ets[, "tran_cm"] + Etotal2, tolerance = tol)
+
+
+ #--- Get other water flux values
+ infiltration <- slot(
+ slot(x, "SOILINFILT"),
+ OutPeriods[pd]
+ )[, "soil_inf"]
+ deepDrainage <- slot(
+ slot(x, "DEEPSWC"),
+ OutPeriods[pd]
+ )[, "lowLayerDrain_cm"]
+
+ temp <- slot(slot(x, "LYRDRAIN"), OutPeriods[pd])
+ ids <- grep("Lyr", colnames(temp), fixed = TRUE)
+ temp <- temp[, ids, drop = FALSE]
+ percolationIn <- cbind(infiltration, temp)
+ percolationOut <- cbind(temp, deepDrainage)
+
+ temp <- slot(slot(x, "HYDRED"), OutPeriods[pd])
+ ctemp <- grep("total_Lyr", colnames(temp), fixed = TRUE)
+ hydraulicRedistribution <- temp[, ctemp, drop = FALSE]
+
+ temp <- slot(slot(x, "INTERCEPTION"), OutPeriods[pd])
+ intercepted <- temp[, "int_total"]
+
+ temp <- slot(slot(x, "RUNOFF"), OutPeriods[pd])
+ ctemp <- grep("runoff", colnames(temp), fixed = TRUE)
+ runoff <- apply(temp[, ctemp, drop = FALSE], 1, sum)
+ ctemp <- grep("runon", colnames(temp), fixed = TRUE)
+ runon <- apply(temp[, ctemp, drop = FALSE], 1, sum)
+
+ temp <- slot(slot(x, "PRECIP"), OutPeriods[pd])
+ snowmelt <- temp[, "snowmelt"]
+ rain <- temp[, "rain"]
+
+ arriving_water <- rain + snowmelt + runon
+
+
+ # Get state change values
+ delta_surfaceWater <- list_delta_surfaceWater[[OutPeriods[pd]]]
+ delta_swcj <- list_delta_swcj[[OutPeriods[pd]]]
+ delta_swc_total <- list_delta_swc_total[[OutPeriods[pd]]]
+
+
+ #--- Water balance checks
+ # (1) \code{AET <= PET}
+ expect_true(all(aet < pet | abs(pet - aet) < tol), info = info2)
+
+ # (2) \code{AET == E(total) + T(total)}
+ expect_equal(aet, Etotal + Ttotal, info = info2)
+
+ # (3) \code{T(total) = sum of T(veg-type i from soil layer j)}
+ expect_equal(
+ Ttotal,
+ apply(
+ sapply(Tvegij, function(x) apply(x, 1, sum)),
+ MARGIN = 1,
+ FUN = sum
+ ),
+ info = info2
+ )
- # Loop through time steps
- for (pd in seq_len(SW_OUTNPERIODS)) {
- info2 <- paste(info1, "/ time step:", OutPeriods[pd])
-
- # Get values
- ets <- slot(slot(x, "AET"), OutPeriods[pd])
- aet <- ets[, "evapotr_cm"]
- pet <- slot(slot(x, "PET"), OutPeriods[pd])[, "pet_cm"]
-
- temp <- seq_along(aet)
- idelta1 <- temp[-length(temp)]
- idelta2 <- temp[-1]
-
- # Get evaporation values
- temp <- slot(slot(x, "EVAPSURFACE"), OutPeriods[pd])
- Etotalsurf <- temp[, "evap_total"]
- Elitter <- temp[, "evap_litter"]
- Eponded <- temp[, "evap_surfaceWater"]
- Evegi <- temp[, paste0("evap_", veg_types), drop = FALSE]
- Eveg <- apply(Evegi, 1, sum)
- Etotalint <- Eveg + Elitter
-
- temp <- slot(slot(x, "EVAPSOIL"), OutPeriods[pd])
- Esoilj <- temp[, grep("Lyr", colnames(temp), fixed = TRUE), drop = FALSE]
- Esoil <- apply(Esoilj, 1, sum)
-
- temp <- matrix(0, nrow = nrow(Esoilj), ncol = n_soillayers)
- temp[, seq_len(ncol(Esoilj))] <- Esoilj
- Esoilj <- temp
-
- Esnow <- slot(slot(x, "PRECIP"), OutPeriods[pd])[, "snowloss"]
- Etotal <- Etotalsurf + Esoil + Esnow
-
- # Get transpiration values
- temp <- slot(slot(x, "TRANSP"), OutPeriods[pd])
- ids <- grep("transp_total_Lyr", colnames(temp), fixed = TRUE)
- Ttotalj <- temp[, ids, drop = FALSE]
- Ttotal <- apply(Ttotalj, 1, sum)
- Tvegij <- lapply(
- veg_types,
- function(v) {
- ids <- grep(
- paste0("transp_", v, "_Lyr"),
- colnames(temp),
- fixed = TRUE
+ # (4) \code{E(total) = E(total bare-soil) + E(ponded water) +
+ # + E(total litter-intercepted) + E(total veg-intercepted) +
+ # + E(snow sublimation)}
+ expect_equal(
+ Etotal, Esoil + Eponded + Eveg + Elitter + Esnow,
+ info = info2
)
- temp[, ids, drop = FALSE]
+
+ # (5) \code{E(total surface) = E(ponded water) +
+ # + E(total litter-intercepted) + E(total veg-intercepted)}
+ expect_equal(
+ Etotalsurf, Eponded + Eveg + Elitter,
+ info = info2
+ )
+
+
+ #--- Water cycling checks
+ # (6) \code{infiltration = [rain + snowmelt + runon] -
+ # (runoff + intercepted + delta_surfaceWater + Eponded)}
+ expect_equal(
+ infiltration[idelta2], arriving_water[idelta2] -
+ (runoff[idelta2] + intercepted[idelta2] + delta_surfaceWater +
+ Eponded[idelta2]),
+ info = info2
+ )
+
+ # (7) \code{E(soil) + Ttotal =
+ # infiltration - (deepDrainage + delta(swc))}
+ expect_equal(
+ Esoil[idelta2] + Ttotal[idelta2],
+ infiltration[idelta2] - (deepDrainage[idelta2] + delta_swc_total),
+ info = info2
+ )
+
+ # (8) for every soil layer j: \code{delta(swc) =
+ # = infiltration/percolationIn + hydraulicRedistribution -
+ # (percolationOut/deepDrainage + transpiration + evaporation)}
+ for (j in seq_len(n_soillayers)) {
+ expect_equal(
+ delta_swcj[, j],
+ percolationIn[idelta2, j] + hydraulicRedistribution[idelta2, j] -
+ (percolationOut[idelta2, j] + Ttotalj[idelta2, j] +
+ Esoilj[idelta2, j]),
+ info = paste(info2, "/ soil layer:", j)
+ )
+ }
}
- )
- names(Tvegij) <- veg_types
-
-
- #--- Check that calculated transpiration and evaporation matches
- # newly available ones from "AET" slot
- expect_equal(Ttotal, ets[, "tran_cm"], tolerance = tol)
- expect_equal(Esoil, ets[, "esoil_cm"], tolerance = tol)
- expect_equal(Esnow, ets[, "esnow_cm"], tolerance = tol)
- expect_equal(Eveg, ets[, "ecnw_cm"], tolerance = tol)
- expect_equal(Eponded + Elitter, ets[, "esurf_cm"], tolerance = tol)
-
- tmp_evars2 <- c("esoil_cm", "ecnw_cm", "esurf_cm", "esnow_cm")
- Etotal2 <- apply(ets[, tmp_evars2], 1, sum)
- expect_equal(Etotal, Etotal2, tolerance = tol)
- expect_equal(aet, ets[, "tran_cm"] + Etotal2, tolerance = tol)
-
-
- #--- Get other water flux values
- infiltration <- slot(slot(x, "SOILINFILT"),
- OutPeriods[pd])[, "soil_inf"]
- deepDrainage <- slot(slot(x, "DEEPSWC"),
- OutPeriods[pd])[, "lowLayerDrain_cm"]
-
- temp <- slot(slot(x, "LYRDRAIN"), OutPeriods[pd])
- temp <- temp[, grep("Lyr", colnames(temp), fixed = TRUE), drop = FALSE]
- percolationIn <- cbind(infiltration, temp)
- percolationOut <- cbind(temp, deepDrainage)
-
- temp <- slot(slot(x, "HYDRED"), OutPeriods[pd])
- ctemp <- grep("total_Lyr", colnames(temp), fixed = TRUE)
- hydraulicRedistribution <- temp[, ctemp, drop = FALSE]
-
- temp <- slot(slot(x, "INTERCEPTION"), OutPeriods[pd])
- intercepted <- temp[, "int_total"]
-
- temp <- slot(slot(x, "RUNOFF"), OutPeriods[pd])
- ctemp <- grep("runoff", colnames(temp), fixed = TRUE)
- runoff <- apply(temp[, ctemp, drop = FALSE], 1, sum)
- ctemp <- grep("runon", colnames(temp), fixed = TRUE)
- runon <- apply(temp[, ctemp, drop = FALSE], 1, sum)
-
- temp <- slot(slot(x, "PRECIP"), OutPeriods[pd])
- snowmelt <- temp[, "snowmelt"]
- rain <- temp[, "rain"]
-
- arriving_water <- rain + snowmelt + runon
-
-
- # Get state change values
- delta_surfaceWater <- list_delta_surfaceWater[[OutPeriods[pd]]]
- delta_swcj <- list_delta_swcj[[OutPeriods[pd]]]
- delta_swc_total <- list_delta_swc_total[[OutPeriods[pd]]]
-
-
- #--- Water balance checks
- # (1) \code{AET <= PET}
- expect_true(all(aet < pet | abs(pet - aet) < tol), info = info2)
-
- # (2) \code{AET == E(total) + T(total)}
- expect_equal(aet, Etotal + Ttotal, info = info2)
-
- # (3) \code{T(total) = sum of T(veg-type i from soil layer j)}
- expect_equal(Ttotal, apply(sapply(Tvegij, function(x) apply(x, 1, sum)),
- 1, sum), info = info2)
-
- # (4) \code{E(total) = E(total bare-soil) + E(ponded water) +
- # + E(total litter-intercepted) + E(total veg-intercepted) +
- # + E(snow sublimation)}
- expect_equal(Etotal, Esoil + Eponded + Eveg + Elitter + Esnow,
- info = info2)
-
- # (5) \code{E(total surface) = E(ponded water) +
- # + E(total litter-intercepted) + E(total veg-intercepted)}
- expect_equal(Etotalsurf, Eponded + Eveg + Elitter, info = info2)
-
-
- #--- Water cycling checks
- # (6) \code{infiltration = [rain + snowmelt + runon] -
- # (runoff + intercepted + delta_surfaceWater + Eponded)}
- expect_equal(infiltration[idelta2], arriving_water[idelta2] -
- (runoff[idelta2] + intercepted[idelta2] + delta_surfaceWater +
- Eponded[idelta2]), info = info2)
-
- # (7) \code{E(soil) + Ttotal = infiltration - (deepDrainage + delta(swc))}
- expect_equal(Esoil[idelta2] + Ttotal[idelta2],
- infiltration[idelta2] - (deepDrainage[idelta2] + delta_swc_total),
- info = info2)
-
- # (8) for every soil layer j: \code{delta(swc) =
- # = infiltration/percolationIn + hydraulicRedistribution -
- # (percolationOut/deepDrainage + transpiration + evaporation)}
- for (j in seq_len(n_soillayers)) {
- expect_equal(delta_swcj[, j],
- percolationIn[idelta2, j] + hydraulicRedistribution[idelta2, j] -
- (percolationOut[idelta2, j] + Ttotalj[idelta2, j] +
- Esoilj[idelta2, j]), info = paste(info2, "/ soil layer:", j))
}
- }
- })
+ })
+ }
}
diff --git a/tests/testthat/test_WeatherData.R b/tests/testthat/test_WeatherData.R
index e8273579..7fa481c9 100644
--- a/tests/testthat/test_WeatherData.R
+++ b/tests/testthat/test_WeatherData.R
@@ -1,4 +1,13 @@
-context("rSOILWAT2 weather data")
+
+path_example1 <- system.file("extdata", "example1", package = "rSOILWAT2")
+dir_weather <- list.files(
+ file.path(path_example1, "Input"),
+ pattern = "data_weather"
+)
+
+test_that("Test data availability", {
+ expect_gt(length(dir_weather), 0)
+})
test_that("Weather data check", {
@@ -7,10 +16,185 @@ test_that("Weather data check", {
expect_false(dbW_check_weatherData(1))
expect_false(dbW_check_weatherData(list()))
expect_false(dbW_check_weatherData(list(1)))
- expect_false(dbW_check_weatherData(new("swWeatherData")))
+ expect_false(dbW_check_weatherData(swWeatherData()))
+ expect_false(dbW_check_weatherData(weatherHistory()))
+ expect_false(dbW_check_weatherData(
+ swWeatherData(rSOILWAT2::weatherData[[1]])
+ ))
- expect_true(dbW_check_weatherData(list(new("swWeatherData"))))
+ expect_true(dbW_check_weatherData(rSOILWAT2::weatherData))
+ expect_true(dbW_check_weatherData(weatherHistory(rSOILWAT2::weatherData)))
expect_true(dbW_check_weatherData(
- get_WeatherHistory(rSOILWAT2::sw_exampleData))
- )
+ list(swWeatherData(rSOILWAT2::weatherData[[1]]))
+ ))
+ expect_true(dbW_check_weatherData(
+ get_WeatherHistory(rSOILWAT2::sw_exampleData)
+ ))
+ expect_true(dbW_check_weatherData(weatherHistory(), check_all = FALSE))
+})
+
+test_that("Missing weather data", {
+ expect_true(is_missing_weather(NA))
+ expect_true(is_missing_weather(NaN))
+ expect_true(is_missing_weather(999))
+
+ expect_false(is_missing_weather(0))
+ expect_false(is_missing_weather(-5))
+ expect_false(is_missing_weather(100))
+})
+
+
+test_that("Weather data sources", {
+ template_swin <- rSOILWAT2::sw_exampleData
+
+ # see data-raw/prepare_testInput_objects.R
+ add_weather_sources <- c("minimalInputs", "daymet", "gridmet", "maca")
+ template_dailyInputFlags <- c(rep(TRUE, 3L), rep(FALSE, 11L))
+
+ for (ws in add_weather_sources) {
+ ws_dailyInputFlags <- switch(
+ EXPR = ws,
+ minimalInputs = template_dailyInputFlags,
+ daymet = {
+ dif <- template_dailyInputFlags
+ dif[13L] <- TRUE # ACTUAL_VP
+ dif[14L] <- TRUE # SHORT_WR, desc_rsds = 2
+ dif
+ },
+ gridmet = {
+ dif <- template_dailyInputFlags
+ dif[5L] <- TRUE # WIND_SPEED
+ dif[9L] <- TRUE # REL_HUMID_MAX
+ dif[10L] <- TRUE # REL_HUMID_MIN
+ dif[14L] <- TRUE # SHORT_WR, desc_rsds = 1
+ dif
+ },
+ maca = {
+ dif <- template_dailyInputFlags
+ dif[6L] <- TRUE # WIND_EAST
+ dif[7L] <- TRUE # WIND_NORTH
+ dif[9L] <- TRUE # REL_HUMID_MAX
+ dif[10L] <- TRUE # REL_HUMID_MIN
+ dif[14L] <- TRUE # SHORT_WR, desc_rsds = 1
+ dif
+ }
+ )
+
+ weatherDirName <- switch(
+ EXPR = ws,
+ minimalInputs = "data_weather",
+ grep(ws, dir_weather, value = TRUE)
+ )
+
+ sww <- list(
+ C = rSOILWAT2::getWeatherData_folders(
+ LookupWeatherFolder = file.path(path_example1, "Input"),
+ weatherDirName = weatherDirName,
+ filebasename = "weath",
+ dailyInputFlags = ws_dailyInputFlags,
+ method = "C"
+ ),
+
+ R = rSOILWAT2::getWeatherData_folders(
+ LookupWeatherFolder = file.path(path_example1, "Input"),
+ weatherDirName = weatherDirName,
+ filebasename = "weath",
+ dailyInputFlags = ws_dailyInputFlags,
+ method = "R"
+ )
+ )
+
+ expect_true(rSOILWAT2::dbW_check_weatherData(sww[["C"]]))
+ expect_true(rSOILWAT2::dbW_check_weatherData(sww[["R"]]))
+
+ years <- rSOILWAT2::get_years_from_weatherData(sww[["C"]])
+
+ expect_identical(
+ years,
+ rSOILWAT2::get_years_from_weatherData(sww[["R"]])
+ )
+
+
+ calc_difs <- lapply(sww, rSOILWAT2::calc_dailyInputFlags)
+
+ expect_equal(
+ ws_dailyInputFlags,
+ calc_difs[["R"]],
+ ignore_attr = "names"
+ )
+
+ expect_true(
+ all(
+ intersect(which(calc_difs[["C"]]), which(calc_difs[["R"]])) %in%
+ which(ws_dailyInputFlags)
+ )
+ )
+
+
+ #--- Prepare simulation run with specified weather data
+ swin <- template_swin
+
+ swYears_EndYear(swin) <- max(years)
+ swYears_StartYear(swin) <- min(years)
+
+ if (ws == "minimalInputs") {
+ swin@weather@desc_rsds <- 0L
+ swin@weather@use_cloudCoverMonthly <- TRUE
+ swin@weather@use_windSpeedMonthly <- TRUE
+ swin@weather@use_humidityMonthly <- TRUE
+
+ } else if (ws == "daymet") {
+ swin@weather@desc_rsds <- 2L # flux density over the daylight period
+ swin@weather@use_cloudCoverMonthly <- FALSE # use radiation instead
+ swin@weather@use_windSpeedMonthly <- TRUE
+ swin@weather@use_humidityMonthly <- FALSE # use vapor pressure instead
+
+ } else if (ws == "gridmet") {
+ swin@weather@desc_rsds <- 1L # flux density over 24-hour period
+ swin@weather@use_cloudCoverMonthly <- FALSE # use radiation instead
+ swin@weather@use_windSpeedMonthly <- FALSE # has daily wind
+ swin@weather@use_humidityMonthly <- FALSE # has humidity
+
+ } else if (ws == "maca") {
+ swin@weather@desc_rsds <- 1L # flux density over 24-hour period
+ swin@weather@use_cloudCoverMonthly <- FALSE # use radiation instead
+ swin@weather@use_windSpeedMonthly <- FALSE # has daily wind
+ swin@weather@use_humidityMonthly <- FALSE # has humidity
+
+ }
+
+
+ #--- Run and check simulation with specified weather data
+ rd <- list()
+
+ for (method in c("C", "R")) {
+ swin@weather@dailyInputFlags <- calc_difs[[method]]
+
+ rd[[method]] <- rSOILWAT2::sw_exec(
+ inputData = swin,
+ weatherList = sww[[method]],
+ echo = FALSE,
+ quiet = TRUE
+ )
+
+ expect_true(rSOILWAT2::check_version(rd[[method]], level = "minor"))
+ expect_s4_class(rd[[method]], "swOutput")
+ expect_false(rSOILWAT2::has_soilTemp_failed())
+ expect_true(all(rSOILWAT2::sw_out_flags() %in% slotNames(rd[[method]])))
+ }
+
+
+ #--- Expect identical simulation output independent of reading method
+ vars <- grep(
+ pattern = "timestamp",
+ x = slotNames(rd[["C"]]),
+ value = TRUE,
+ invert = TRUE,
+ fixed = TRUE
+ )
+
+ for (var in vars) {
+ expect_identical(slot(rd[["C"]], var), slot(rd[["R"]], var))
+ }
+ }
})
diff --git a/tests/testthat/test_WeatherGenerator_functionality.R b/tests/testthat/test_WeatherGenerator_functionality.R
index e31bf645..c2c0000e 100644
--- a/tests/testthat/test_WeatherGenerator_functionality.R
+++ b/tests/testthat/test_WeatherGenerator_functionality.R
@@ -1,41 +1,45 @@
-context("rSOILWAT2 weather generator")
#---INPUTS
-path_extdata <- file.path("..", "..", "inst", "extdata")
-if (!dir.exists(path_extdata)) {
- path_extdata <- system.file("extdata", package = "rSOILWAT2")
-}
-
-
dir_test_data <- file.path("..", "test_data")
temp <- list.files(dir_test_data, pattern = "Ex")
temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(temp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
-sw_weather <- lapply(
- tests,
- function(it) readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
-)
#---TESTS
+test_that("Weather generator: estimate input parameters", {
+ weatherGenerator_dataColumns <- c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
-test_that("Weather generator: estimate input parameters", {
for (k in seq_along(tests)) {
- test_dat <- sw_weather[[k]]
- test_df <- data.frame(dbW_weatherData_to_dataframe(test_dat, valNA = NULL))
+ test_dat <- readRDS(
+ file.path(dir_test_data, paste0(tests[k], "_weather.rds"))
+ )
- if (anyNA(test_df)) {
- expect_warning(res <- dbW_estimate_WGen_coefs(test_df,
- propagate_NAs = TRUE),
- "Insufficient weather data to estimate values")
+ test_df <- data.frame(dbW_weatherData_to_dataframe(test_dat, valNA = NULL))
- expect_message(res <- dbW_estimate_WGen_coefs(test_df,
- propagate_NAs = FALSE,
- imputation_type = "mean"),
- "Impute missing")
+ if (anyNA(test_df[, weatherGenerator_dataColumns(), drop = FALSE])) {
+ # We have NAs that propagate
+ # --> warnings: "Insufficient weather data to estimate values [...]"
+ res <- suppressWarnings(
+ dbW_estimate_WGen_coefs(test_df, propagate_NAs = TRUE)
+ )
+ expect_true(all(is.na(res[["mkv_woy"]][, -1])))
+ expect_true(all(is.na(res[["mkv_doy"]][, -1])))
+
+ # We have NAs that we impute
+ # --> messages: "Impute missing [...]"
+ res <- suppressMessages(
+ dbW_estimate_WGen_coefs(
+ test_df,
+ propagate_NAs = FALSE,
+ imputation_type = "mean"
+ )
+ )
} else {
res <- dbW_estimate_WGen_coefs(test_df)
@@ -48,72 +52,131 @@ test_that("Weather generator: estimate input parameters", {
# validity tests ok
sw_in <- rSOILWAT2::sw_exampleData
- expect_equal(swMarkov_Prob(sw_in) <- res[["mkv_doy"]], res[["mkv_doy"]])
- expect_equal(swMarkov_Conv(sw_in) <- res[["mkv_woy"]], res[["mkv_woy"]])
+ expect_equal(
+ swMarkov_Prob(sw_in) <- res[["mkv_doy"]],
+ res[["mkv_doy"]]
+ )
+ expect_equal(
+ swMarkov_Conv(sw_in) <- res[["mkv_woy"]],
+ res[["mkv_woy"]]
+ )
}
})
test_that("Weather generator: generate weather", {
+ digits <- 9L
+
for (k in seq_along(tests)) {
- test_dat <- sw_weather[[k]]
+ test_dat <- readRDS(
+ file.path(dir_test_data, paste0(tests[k], "_weather.rds"))
+ )
years <- get_years_from_weatherData(test_dat)
n <- length(test_dat)
wout <- list()
# Case 1: generate weather for dataset and impute missing values
- wout[[1]] <- dbW_generateWeather(test_dat,
- imputation_type = "mean",
- imputation_span = 5)
+ wout[[1]] <- suppressMessages(
+ dbW_generateWeather(
+ test_dat,
+ imputation_type = "mean",
+ imputation_span = 5,
+ digits = digits,
+ seed = 123
+ )
+ )
# Case 2: generate weather based on partial dataset,
# use estimated weather generator coefficients from full dataset
- wgen_coeffs <- dbW_estimate_WGen_coefs(test_dat,
- imputation_type = "mean",
- imputation_span = 5)
- wout[[2]] <- dbW_generateWeather(test_dat[(n - 5):n],
+ wgen_coeffs <- suppressMessages(
+ dbW_estimate_WGen_coefs(
+ test_dat,
+ imputation_type = "mean",
+ imputation_span = 5
+ )
+ )
+
+ wout[[2]] <- dbW_generateWeather(
+ test_dat[(n - 5):n],
years = years[length(years)] + 0:10 - 5,
- wgen_coeffs = wgen_coeffs)
+ wgen_coeffs = wgen_coeffs
+ )
# Case 3: generate weather based only on estimated weather generator
# coefficients from full dataset
- x_empty <- list(new("swWeatherData"))
- wout[[3]] <- dbW_generateWeather(x_empty,
+ x_empty <- weatherHistory()
+ wout[[3]] <- dbW_generateWeather(
+ x_empty,
years = years[length(years)] + 30:40,
- wgen_coeffs = wgen_coeffs)
-
- # Expectations
- for (k in seq_along(wout)) {
- x <- wout[[k]]
- iyrs <- seq_along(x)
-
- for (i in iyrs) {
- # It is a valid object of class "swWeatherData"
- expect_true(swWeatherData_validity(x[[i]]))
-
- # Prepare weather data.frame
- wdf <- slot(x[[i]], "data")
- wdf <- set_missing_weather(wdf)
-
- # It meets weather data requirements
- expect_silent(
- check_weather(
- weather = wdf,
- required_variables = c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
- ))
-
- # There are no missing data
- expect_false(anyNA(wdf))
- }
+ wgen_coeffs = wgen_coeffs
+ )
+
+
+ #--- Expectations
+ for (ke in seq_along(wout)) {
+
+ # Expect valid weather history object
+ expect_true(dbW_check_weatherData(wout[[ke]]))
+
+ wdf <- dbW_weatherData_to_dataframe(wout[[ke]])
+ wdf <- wdf[, weatherGenerator_dataColumns(), drop = FALSE]
+
+ #--- Expect no missing data in implemented variables
+ expect_false(any(is_missing_weather(wdf)))
}
+
+
+ #--- Expect that values remain unchanged
+ # wgen-variables: on days where all wgen-variables are non-missing
+ # Non-wgen variables: any non-missing value remain unchanged
+
+ wout1_df <- rSOILWAT2::dbW_weatherData_to_dataframe(wout[[1L]])
+ test_dat1_df <- rSOILWAT2::dbW_weatherData_to_dataframe(test_dat)
+
+ ids_wgen <- which(
+ colnames(test_dat1_df) %in% rSOILWAT2::weatherGenerator_dataColumns()
+ )
+ tmp <- apply(
+ !is_missing_weather(test_dat1_df[, ids_wgen, drop = FALSE]),
+ MARGIN = 1L,
+ FUN = all
+ )
+ isnot_missing_wgen <- as.matrix(data.frame(
+ row = rep(which(tmp), times = length(ids_wgen)),
+ col = rep(ids_wgen, each = sum(tmp))
+ ))
+
+ ids_nowgen <- which(
+ !colnames(test_dat1_df) %in% rSOILWAT2::weatherGenerator_dataColumns()
+ )
+ isnot_missing_nowgen <- which(
+ !is_missing_weather(test_dat1_df[, ids_nowgen, drop = FALSE]),
+ arr.ind = TRUE
+ )
+ isnot_missing_nowgen[, "col"] <- ids_nowgen[isnot_missing_nowgen[, "col"]]
+
+ isnot_missing <- rbind(isnot_missing_wgen, isnot_missing_nowgen)
+
+
+ expect_equal(
+ test_dat1_df[isnot_missing],
+ wout1_df[isnot_missing],
+ tolerance = 10 ^ (-digits)
+ )
}
})
test_that("Weather generator (integration tests): compare input/output", {
- skip_if_not(identical(tolower(Sys.getenv("RSOILWAT_INTEGRATIONTESTS")),
- "true"))
+ skip_if_not(
+ identical(
+ tolower(Sys.getenv("RSOILWAT_INTEGRATIONTESTS")),
+ "true"
+ )
+ )
+
+ tag <- "IntegrationTest-WeatherGenerator"
dir_inttests <- file.path("..", "rSOILWAT_IntegrationTestOutput")
dir.create(dir_inttests, showWarnings = FALSE)
@@ -137,32 +200,53 @@ test_that("Weather generator (integration tests): compare input/output", {
res <- dbW_estimate_WGen_coefs(obs_df, imputation_type = "mean")
swMarkov_Prob(sw_in) <- res[["mkv_doy"]]
swMarkov_Conv(sw_in) <- res[["mkv_woy"]]
- set_swWeatherData(sw_in) <- new("swWeatherData")
-
- wgen_df <- replicate(N, {
- res <- sw_exec(inputData = sw_in)
-
- out <- lapply(time_steps, function(it) {
- temp <- slot(slot(res, "TEMP"), it)
-
- data.frame(
- if (it == "Year") {
- temp[, "Year", drop = FALSE]
- } else {
- temp[, c("Year", it)]
- },
- Tmax_C = temp[, "max_C"],
- Tmin_C = temp[, "min_C"],
- PPT_cm = slot(slot(res, "PRECIP"), it)[, "ppt"]
+ set_WeatherHistory(sw_in) <- weatherHistory()
+
+ wgen_df <- replicate(
+ N,
+ {
+ res <- sw_exec(inputData = sw_in)
+
+ out <- lapply(
+ time_steps,
+ function(it) {
+ temp <- slot(slot(res, "TEMP"), it)
+
+ data.frame(
+ if (it == "Year") {
+ temp[, "Year", drop = FALSE]
+ } else {
+ temp[, c("Year", it)]
+ },
+ Tmax_C = temp[, "max_C"],
+ Tmin_C = temp[, "min_C"],
+ PPT_cm = slot(slot(res, "PRECIP"), it)[, "ppt"]
+ )
+ }
)
- })
- names(out) <- time_steps
- out
- }, simplify = FALSE)
+ names(out) <- time_steps
+ out
+ },
+ simplify = FALSE
+ )
- #--- Comparison
- compare_weather(ref_weather = obs_df, weather = wgen_df, N = N,
- path = dir_inttests, tag = "IntegrationTest-WeatherGenerator")
+ #--- Comparison
+ suppressMessages(
+ compare_weather(
+ ref_weather = obs_df,
+ weather = wgen_df,
+ N = N,
+ path = dir_inttests,
+ tag = tag
+ )
+ )
+ expect_length(
+ list.files(
+ path = dir_inttests,
+ pattern = tag
+ ),
+ n = 4L
+ )
})
diff --git a/tests/testthat/test_class_constructors.R b/tests/testthat/test_class_constructors.R
new file mode 100644
index 00000000..56781ded
--- /dev/null
+++ b/tests/testthat/test_class_constructors.R
@@ -0,0 +1,67 @@
+
+test_that("Class constructors", {
+
+ ref <- rSOILWAT2::sw_exampleData
+ expect_s4_class(ref, "swInputData")
+
+ sns <- slotNames(ref)
+ sns_dc <- setdiff(sns, c("timestamp", "version"))
+
+ tmp <- vapply(
+ sns_dc,
+ function(x) class(slot(ref, x)),
+ FUN.VALUE = NA_character_
+ )
+ list_classes <- setdiff(tmp, c("list", "swLog"))
+
+
+ #--- Check that constructor helper for "swInputData" reproduces (valid) inputs
+ expect_s4_class(swInputData(), "swInputData")
+ x <- swInputData(ref)
+ expect_s4_class(x, "swInputData")
+
+ for (ks in sns_dc) {
+ expect_true(validObject(slot(x, ks)))
+ expect_equal(slot(x, ks), slot(ref, ks))
+ }
+
+
+ #--- Loop over classes ------
+ for (cn in list_classes) {
+ fun_constructor <- match.fun(cn)
+ fun_extractor <- match.fun(paste0("get_", cn))
+
+ #--- Check that constructor helper for each class reproduces inputs
+ expect_s4_class(fun_constructor(), cn)
+ x <- fun_constructor(fun_extractor(ref))
+ expect_s4_class(x, cn)
+ expect_equal(x, fun_extractor(ref))
+
+ #--- Check that new class objects are valid
+ expect_true(validObject(new(cn)))
+ expect_true(validObject(fun_constructor()))
+ }
+
+
+ #--- Check special case: "swWeatherData"
+ expect_s4_class(swWeatherData(), "swWeatherData")
+ x <- swWeatherData(get_swWeatherData(ref, 1980))
+ expect_s4_class(x, "swWeatherData")
+ expect_equal(x, get_swWeatherData(ref, 1980))
+
+
+ #--- Check special case: "weatherHistory"
+ expect_type(weatherHistory(), "list")
+ expect_s4_class(weatherHistory()[[1]], "swWeatherData")
+ x <- weatherHistory(get_WeatherHistory(ref))
+ expect_type(x, "list")
+ expect_s4_class(x[[1]], "swWeatherData")
+ expect_equal(x, get_WeatherHistory(ref))
+
+
+ #--- Check special case: "swLog"
+ expect_s4_class(swLog(), "swLog")
+ x <- swLog(ref@log)
+ expect_s4_class(x, "swLog")
+ expect_equal(x, ref@log)
+})
diff --git a/tests/testthat/test_class_swCarbon.R b/tests/testthat/test_class_swCarbon.R
index 843453ba..892431eb 100644
--- a/tests/testthat/test_class_swCarbon.R
+++ b/tests/testthat/test_class_swCarbon.R
@@ -1,11 +1,10 @@
-context("Carbon dioxide class")
#---TESTS
test_that("Manipulate swCarbon", {
x <- new("swCarbon")
expect_s4_class(x, "swCarbon")
- xinput <- xinput2 <- new("swCarbon")
+ xinput <- xinput2 <- swCarbon()
expect_s4_class(get_swCarbon(xinput), "swCarbon")
co2 <- as.matrix(data.frame(Year = 1951:2000, CO2ppm = 360 + seq_len(50) / 2))
swCarbon_CO2ppm(xinput) <- co2
@@ -14,7 +13,7 @@ test_that("Manipulate swCarbon", {
# Get/set entire carbon class object
cco2 <- get_swCarbon(xinput)
- cco2_new <- new("swCarbon")
+ cco2_new <- swCarbon()
expect_false(isTRUE(all.equal(cco2, cco2_new)))
set_swCarbon(cco2_new) <- cco2
expect_equal(cco2, cco2_new)
diff --git a/tests/testthat/test_class_swProd.R b/tests/testthat/test_class_swProd.R
index 3906f99d..032f3888 100644
--- a/tests/testthat/test_class_swProd.R
+++ b/tests/testthat/test_class_swProd.R
@@ -1,38 +1,39 @@
-context("Vegetation parameters class")
-
-ids_VegType <- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]
-names_VegTypes <- tolower(
- gsub(
- "SW_",
- "",
- names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]),
- fixed = TRUE
- )
-)
-
-names_VegTypes2 <- sapply(
- names_VegTypes,
- function(x) {
- if (endsWith(x, "s")) {
- if (endsWith(x, "ss")) x else substr(x, 1, nchar(x) - 1)
- } else {
- x
- }
- }
-)
+
#---TESTS
test_that("Manipulate 'swProd' class", {
+ ids_VegType <- rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]
+ names_VegTypes <- tolower(
+ gsub(
+ "SW_",
+ "",
+ names(rSW2_glovars[["kSOILWAT2"]][["VegTypes"]]),
+ fixed = TRUE
+ )
+ )
+
+ names_VegTypes2 <- sapply(
+ names_VegTypes,
+ function(x) {
+ if (endsWith(x, "s")) {
+ if (endsWith(x, "ss")) x else substr(x, 1, nchar(x) - 1)
+ } else {
+ x
+ }
+ }
+ )
+
+
x <- new("swProd")
expect_s4_class(x, "swProd")
# Tests for the 'swProd' slot of signature 'swInputData'
- xinput <- xinput2 <- new("swInputData")
+ xinput <- xinput2 <- swInputData()
expect_s4_class(get_swProd(xinput), "swProd")
x1 <- get_swProd(xinput)
- x2 <- new("swProd")
+ x2 <- swProd()
expect_equal(x1, x2)
set_swProd(xinput2) <- x1
expect_equal(xinput, xinput2)
@@ -44,18 +45,26 @@ test_that("Manipulate 'swProd' class", {
for (k in ids_VegType) {
#--- extraction methods
# integer-index version
- expect_equal(swProd_MonProd_veg(xinput, 1 + k),
- swProd_MonProd_veg(xinv, 1 + k))
+ expect_equal(
+ swProd_MonProd_veg(xinput, 1 + k),
+ swProd_MonProd_veg(xinv, 1 + k)
+ )
# character-index version
- expect_equal(swProd_MonProd_veg(xinput, names_VegTypes[1 + k]),
- swProd_MonProd_veg(xinv, names_VegTypes[1 + k]))
- expect_equal(swProd_MonProd_veg(xinv, 1 + k),
- swProd_MonProd_veg(xinv, names_VegTypes[1 + k]))
+ expect_equal(
+ swProd_MonProd_veg(xinput, names_VegTypes[1 + k]),
+ swProd_MonProd_veg(xinv, names_VegTypes[1 + k])
+ )
+ expect_equal(
+ swProd_MonProd_veg(xinv, 1 + k),
+ swProd_MonProd_veg(xinv, names_VegTypes[1 + k])
+ )
# veg-type named version
- f <- utils::getFromNamespace(paste0("swProd_MonProd_",
- names_VegTypes2[1 + k]), ns = "rSOILWAT2")
+ f <- utils::getFromNamespace(
+ paste0("swProd_MonProd_", names_VegTypes2[1 + k]),
+ ns = "rSOILWAT2"
+ )
expect_equal(f(xinput), f(xinv))
expect_equal(swProd_MonProd_veg(xinv, 1 + k), f(xinv))
@@ -68,8 +77,10 @@ test_that("Manipulate 'swProd' class", {
expect_error(swProd_MonProd_veg(xinput, names_VegTypes[1 + k]) <- data_fail)
expect_error(swProd_MonProd_veg(xinv, names_VegTypes[1 + k]) <- data_fail)
- fr <- utils::getFromNamespace(paste0("swProd_MonProd_",
- names_VegTypes2[1 + k], "<-"), ns = "rSOILWAT2")
+ fr <- utils::getFromNamespace(
+ paste0("swProd_MonProd_", names_VegTypes2[1 + k], "<-"),
+ ns = "rSOILWAT2"
+ )
expect_error(fr(xinput, data_fail))
expect_error(fr(xinv, data_fail))
diff --git a/tests/testthat/test_class_swSite.R b/tests/testthat/test_class_swSite.R
index a6b9ee82..2ec5e200 100644
--- a/tests/testthat/test_class_swSite.R
+++ b/tests/testthat/test_class_swSite.R
@@ -1,11 +1,12 @@
-context("Site parameters class")
dir_test_data <- file.path("..", "test_data")
temp <- list.files(dir_test_data, pattern = "Ex")
temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(temp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
#---TESTS
@@ -14,18 +15,20 @@ test_that("Manipulate 'swSite' class", {
expect_s4_class(x, "swSite")
#--- Tests for the 'swSite' slot of signature 'swInputData'
- xinput <- xinput2 <- new("swInputData")
+ xinput <- xinput2 <- swInputData()
expect_s4_class(get_swSite(xinput), "swSite")
site1 <- get_swSite(xinput)
- site2 <- new("swSite")
+ site2 <- swSite()
expect_equal(site1, site2)
set_swSite(xinput2) <- site1
expect_equal(xinput, xinput2)
#--- Slot 'ModelCoefficients'
- expect_equal(swSite_ModelCoefficients(xinput),
- swSite_ModelCoefficients(get_swSite(xinput)))
+ expect_equal(
+ swSite_ModelCoefficients(xinput),
+ swSite_ModelCoefficients(get_swSite(xinput))
+ )
mc <- mc_ok <- swSite_ModelCoefficients(xinput2)
expect_equal(swSite_ModelCoefficients(xinput2), mc)
@@ -33,42 +36,35 @@ test_that("Manipulate 'swSite' class", {
mc["PETmultiplier"] <- 4
swSite_ModelCoefficients(site1) <- mc
swSite_ModelCoefficients(xinput2) <- mc
- expect_equal(swSite_ModelCoefficients(xinput2),
- swSite_ModelCoefficients(site1))
-
- mc["PETmultiplier"] <- -1
- expect_error(swSite_ModelCoefficients(site1) <- mc)
- expect_error(swSite_ModelCoefficients(xinput2) <- mc)
+ expect_equal(
+ swSite_ModelCoefficients(xinput2),
+ swSite_ModelCoefficients(site1)
+ )
mc <- mc_ok
mc["DailyRunoff"] <- 0.9
swSite_ModelCoefficients(site1) <- mc
swSite_ModelCoefficients(xinput2) <- mc
- expect_equal(swSite_ModelCoefficients(xinput2),
- swSite_ModelCoefficients(site1))
-
- mc["DailyRunoff"] <- -1
- expect_error(swSite_ModelCoefficients(site1) <- mc)
- expect_error(swSite_ModelCoefficients(xinput2) <- mc)
-
- mc["DailyRunoff"] <- 1.5
- expect_error(swSite_ModelCoefficients(site1) <- mc)
- expect_error(swSite_ModelCoefficients(xinput2) <- mc)
+ expect_equal(
+ swSite_ModelCoefficients(xinput2),
+ swSite_ModelCoefficients(site1)
+ )
mc <- mc_ok
mc["DailyRunon"] <- 4
swSite_ModelCoefficients(site1) <- mc
swSite_ModelCoefficients(xinput2) <- mc
- expect_equal(swSite_ModelCoefficients(xinput2),
- swSite_ModelCoefficients(site1))
+ expect_equal(
+ swSite_ModelCoefficients(xinput2),
+ swSite_ModelCoefficients(site1)
+ )
- mc["DailyRunon"] <- -1
- expect_error(swSite_ModelCoefficients(site1) <- mc)
- expect_error(swSite_ModelCoefficients(xinput2) <- mc)
#--- Slot TranspirationRegions
- expect_equal(swSite_TranspirationRegions(xinput),
- swSite_TranspirationRegions(get_swSite(xinput)))
+ expect_equal(
+ swSite_TranspirationRegions(xinput),
+ swSite_TranspirationRegions(get_swSite(xinput))
+ )
mc <- mc_ok <- swSite_TranspirationRegions(xinput2)
expect_equal(swSite_TranspirationRegions(xinput2), mc)
@@ -97,8 +93,13 @@ test_that("Run 'rSOILWAT2' with different 'swSite' inputs", {
# Run SOILWAT
expect_s4_class(
- sw_exec(inputData = sw_input, weatherList = sw_weather, echo = FALSE,
- quiet = TRUE),
- "swOutput")
+ sw_exec(
+ inputData = sw_input,
+ weatherList = sw_weather,
+ echo = FALSE,
+ quiet = TRUE
+ ),
+ "swOutput"
+ )
}
})
diff --git a/tests/testthat/test_climate_functions.R b/tests/testthat/test_climate_functions.R
index f50472cb..0ede6bd0 100644
--- a/tests/testthat/test_climate_functions.R
+++ b/tests/testthat/test_climate_functions.R
@@ -1,4 +1,3 @@
-context("Calculations of climate variables")
# Inputs
weatherList_year1980 <- readRDS(
diff --git a/tests/testthat/test_dbW_functionality.R b/tests/testthat/test_dbW_functionality.R
index 7c36f4cf..12e45215 100644
--- a/tests/testthat/test_dbW_functionality.R
+++ b/tests/testthat/test_dbW_functionality.R
@@ -1,4 +1,3 @@
-context("rSOILWAT2 weather database")
#--- INPUTS ------
path_extdata <- file.path("..", "..", "inst", "extdata")
@@ -15,7 +14,9 @@ dir_test_data <- file.path("..", "test_data")
tmp <- list.files(dir_test_data, pattern = "Ex")
tmp <- sapply(strsplit(tmp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(tmp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
sw_weather <- lapply(
tests,
@@ -55,8 +56,6 @@ site_data3 <- data.frame(
stringsAsFactors = FALSE
)
-weatherDF_dataColumns <- c("DOY", "Tmax_C", "Tmin_C", "PPT_cm")
-
# This function is needed for appveyor: for some reason 'dbW_createDatabase'
@@ -96,10 +95,11 @@ test_that("Disk file write and delete permissions", {
info = paste("Failed to create file", fdbWeather)
)
- expect_message(
- tmp <- try(unlink_forcefully(fdbWeather, info = "1st"), silent = TRUE),
- regexp = "sucessfully deleted"
+ tmp <- try(
+ suppressMessages(unlink_forcefully(fdbWeather, info = "1st")),
+ silent = TRUE
)
+
hasnot_fdbW <- !inherits(tmp, "try-error") && !file.exists(fdbWeather)
expect_true(
hasnot_fdbW,
@@ -123,10 +123,11 @@ test_that("dbW creation", {
dbW_setConnection(fdbWeather, create_if_missing = FALSE, verbose = TRUE),
regexp = "does not exist"
)
- expect_message(
- dbW_setConnection(fdbWeather, create_if_missing = TRUE, verbose = TRUE),
- regexp = "creating a new database"
+ expect_true(
+ dbW_setConnection(fdbWeather, create_if_missing = TRUE, verbose = FALSE)
)
+ expect_true(file.exists(fdbWeather))
+ expect_true(dbW_IsValid())
unlink(fdbWeather)
expect_false(dbW_setConnection(fdbWeather2, create_if_missing = TRUE))
@@ -135,31 +136,42 @@ test_that("dbW creation", {
regexp = "exists but is likely not a SQLite-database"
)
expect_false(dbW_setConnection(fdbWeather3, create_if_missing = TRUE))
- expect_message(
- dbW_setConnection(fdbWeather3, create_if_missing = TRUE, verbose = TRUE),
- regexp = "cannot be created likely because the path does not exist"
+ expect_false(
+ dbW_setConnection(fdbWeather3, create_if_missing = TRUE, verbose = FALSE)
)
+ expect_false(file.exists(fdbWeather3))
expect_false(dbW_IsValid())
+
#--- * Create weather database and check that connection ------
- expect_message(
- dbW_createDatabase(
- fdbWeather,
- site_data = site_data1,
- Scenarios = scenarios,
- scen_ambient = scenarios[1],
- verbose = TRUE,
- ARG_DOESNT_EXIST = 1:3
- ),
- regexp = "arguments ignored/deprecated"
+ # Warnings: arguments ignored/deprecated 'ARG_DOESNT_EXIST'
+ expect_true(
+ suppressMessages(
+ dbW_createDatabase(
+ fdbWeather,
+ site_data = site_data1,
+ Scenarios = scenarios,
+ scen_ambient = scenarios[1],
+ verbose = FALSE,
+ ARG_DOESNT_EXIST = 1:3
+ )
+ )
)
+ expect_true(file.exists(fdbWeather))
+ expect_true(dbW_IsValid())
unlink(fdbWeather)
# Minimal inputs
expect_true(dbW_createDatabase(fdbWeather))
- expect_message(
- unlink_forcefully(fdbWeather, info = "2nd"),
- regexp = "sucessfully deleted"
+ # expect that deletion does not result in an error
+ expect_false(
+ inherits(
+ try(
+ suppressMessages(unlink_forcefully(fdbWeather, info = "1st")),
+ silent = TRUE
+ ),
+ "try-error"
+ )
)
@@ -191,18 +203,19 @@ test_that("dbW creation", {
unlink_forcefully(fdbWeather, info = "4th"),
regexp = "sucessfully deleted"
)
- expect_message(
- dbW_createDatabase(
- fdbWeather,
- site_data = NA,
- Scenarios = scenarios,
- scen_ambient = scenarios[1],
- verbose = TRUE
- ),
- regexp = "errors in the table data"
- )
+ # 'dbW_createDatabase': deletes db-file due to failure.
+ dbW_createDatabase(
+ fdbWeather,
+ site_data = NA,
+ Scenarios = scenarios,
+ scen_ambient = scenarios[1],
+ verbose = FALSE
+ )
+ expect_false(file.exists(fdbWeather))
+ expect_false(dbW_IsValid())
unlink(fdbWeather)
+
expect_true(
dbW_createDatabase(
fdbWeather,
@@ -830,7 +843,7 @@ test_that("Manipulate weather data: years", {
datA_DF_result_con1 <- get_years_from_weatherDF(
weatherDF = datA_DF,
years = datA_yrs_ts,
- weatherDF_dataColumns = weatherDF_dataColumns
+ weatherDF_dataColumns = "DOY"
)
expect_equal(datA_DF_result_con1[["years"]], datA_yrs)
expect_equal(datA_DF_result_con1[["year_ts"]], datA_yrs_ts)
@@ -838,19 +851,19 @@ test_that("Manipulate weather data: years", {
datA_DF_result_con2 <- get_years_from_weatherDF(
weatherDF = datA_DF,
years = datA_yrs,
- weatherDF_dataColumns = weatherDF_dataColumns
+ weatherDF_dataColumns = "DOY"
)
expect_equal(datA_DF_result_con2[["years"]], datA_yrs)
expect_equal(datA_DF_result_con2[["year_ts"]], datA_yrs_ts)
expect_error(
- get_years_from_weatherDF(datA_DF, datA_yrs[2:20], weatherDF_dataColumns)
+ get_years_from_weatherDF(datA_DF, datA_yrs[2:20], "DOY")
) #con 3
datA_DF_result_con4 <- get_years_from_weatherDF(
weatherDF = datA_DF,
years = NULL,
- weatherDF_dataColumns = weatherDF_dataColumns
+ weatherDF_dataColumns = "DOY"
)
expect_equal(datA_DF_result_con4[["years"]], datA_yrs)
expect_equal(datA_DF_result_con4[["year_ts"]], datA_yrs_ts)
@@ -859,7 +872,7 @@ test_that("Manipulate weather data: years", {
get_years_from_weatherDF(
weatherDF = datA_DF_noyrs,
years = NULL,
- weatherDF_dataColumns = weatherDF_dataColumns
+ weatherDF_dataColumns = "DOY"
)
) #con 5
@@ -873,10 +886,21 @@ test_that("Manipulate weather data: years", {
datB <- sw_weather[[k]]
datB_yrs <- get_years_from_weatherData(datB)
yrs_joint <- intersect(datA_yrs, datB_yrs)
+
+ # exclude calculated variables from comparison
+ ids <- c(
+ 1:2,
+ 2L + which(slot(slot(sw_input, "weather"), "dailyInputFlags"))
+ )
+
expect_equal(
- datA[select_years(datA_yrs, min(yrs_joint), max(yrs_joint))],
- datB[select_years(datB_yrs, min(yrs_joint), max(yrs_joint))],
- tol = 1e-3
+ dbW_weatherData_to_dataframe(
+ datA[select_years(datA_yrs, min(yrs_joint), max(yrs_joint))]
+ )[, ids, drop = FALSE],
+ dbW_weatherData_to_dataframe(
+ datB[select_years(datB_yrs, min(yrs_joint), max(yrs_joint))]
+ )[, ids, drop = FALSE],
+ tolerance = 1e-3
)
}
}
@@ -886,6 +910,10 @@ test_that("Manipulate weather data: years", {
test_that("Convert calendar years", {
wdata <- rSOILWAT2::weatherData
+ dailyInputFlags <- calc_dailyInputFlags(wdata)
+ ids_vars <- 2L + which(dailyInputFlags)
+ ids_cols <- c(1:2, ids_vars)
+
## Transfer to different years (partially overlapping)
wnew <- dbW_convert_to_GregorianYears(
wdata,
@@ -893,8 +921,8 @@ test_that("Convert calendar years", {
new_endYear = 2020
)
expect_equal(unique(wnew[, "Year"]), 2000:2020)
- expect_false(anyNA(wnew[wnew[, "Year"] %in% names(wdata), ]))
- expect_true(anyNA(wnew))
+ expect_false(anyNA(wnew[wnew[, "Year"] %in% names(wdata), ids_cols]))
+ expect_true(anyNA(wnew[, ids_cols]))
## Transfer to a subset of years (i.e., subset)
wnew <- dbW_convert_to_GregorianYears(
@@ -903,10 +931,10 @@ test_that("Convert calendar years", {
new_endYear = 2005
)
expect_equal(unique(wnew[, "Year"]), 2000:2005)
- expect_false(anyNA(wnew))
+ expect_false(anyNA(wnew[, ids_cols]))
## Correct/convert from a non-leap to a Gregorian calendar
- wempty <- dbW_weatherData_to_dataframe(list(new("swWeatherData")))[1:365, ]
+ wempty <- dbW_weatherData_to_dataframe(weatherHistory())[1:365, ]
wnew <- dbW_convert_to_GregorianYears(
wempty,
@@ -915,7 +943,7 @@ test_that("Convert calendar years", {
)
expect_equal(unique(wnew[, "Year"]), 2016:2016)
expect_equal(nrow(wnew), 366) # leap year
- expect_true(anyNA(wnew))
+ expect_true(anyNA(wnew[, ids_cols]))
wnew <- dbW_convert_to_GregorianYears(
@@ -926,5 +954,6 @@ test_that("Convert calendar years", {
)
expect_equal(unique(wnew[, "Year"]), 2016:2016)
expect_equal(nrow(wnew), 366) # leap year
- expect_equal(sum(is.na(wnew)), 3) # 3 variables on leap day are missing
+ # variables on leap day are missing
+ expect_equal(sum(is.na(wnew[, ids_cols])), length(ids_vars))
})
diff --git a/tests/testthat/test_exec_and_aggregate.R b/tests/testthat/test_exec_and_aggregate.R
index 250aa756..69f75a12 100644
--- a/tests/testthat/test_exec_and_aggregate.R
+++ b/tests/testthat/test_exec_and_aggregate.R
@@ -1,4 +1,3 @@
-context("rSOILWAT2 runs")
#---CONSTANTS
tols <- list(
@@ -13,15 +12,24 @@ temp <- list.files(dir_test_data, pattern = "Ex")
temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(temp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
+
var_maybeZero <- c("ESTABL", "RUNOFF", "SOILTEMP", "SURFACEWATER", "LOG")
var_SumNotZero <- sw_out_flags()
var_SumNotZero <- var_SumNotZero[!(var_SumNotZero %in% var_maybeZero)]
-expect_within <- function(object, expected, ..., info = NULL,
- tol = tols[["ranges"]], digits_N = 4L) {
+expect_within <- function(
+ object,
+ expected,
+ ...,
+ info = NULL,
+ tol = tols[["ranges"]],
+ digits_N = 4L
+) {
robj <- range(object)
rexp <- range(expected)
@@ -32,7 +40,8 @@ expect_within <- function(object, expected, ..., info = NULL,
lte <- rexp[2] - robj[2] >= -tol
within <- gte & lte
- expect_equivalent(within, TRUE,
+ expect_true(
+ within,
info = paste(
info,
if (!gte) {
@@ -137,14 +146,14 @@ for (it in tests) {
dbW_df_day <- dbW_weatherData_to_dataframe(sw_weather)
test_that("Check weather", {
- expect_equivalent(
+ expect_equal(
dbW_dataframe_to_monthly(dbW_df_day),
dbW_weatherData_to_monthly(sw_weather),
info = info1
)
if (anyNA(dbW_df_day)) {
- expect_equivalent(
+ expect_equal(
dbW_dataframe_to_monthly(dbW_df_day, na.rm = TRUE),
dbW_weatherData_to_monthly(sw_weather, na.rm = TRUE),
info = info1
@@ -166,6 +175,7 @@ for (it in tests) {
expect_true(check_version(rd, level = "minor"))
expect_s4_class(rd, "swOutput")
expect_false(has_soilTemp_failed())
+ expect_true(all(sw_out_flags() %in% slotNames(rd)))
# Run silently/verbosely
expect_silent(sw_exec(
@@ -185,24 +195,30 @@ for (it in tests) {
}
- # Check that input weather is identical to output weather (unless weather
- # generator is turned on)
- if (!swWeather_UseMarkov(sw_input)) {
- # Precipitation
- sim <- slot(slot(rd, "PRECIP"), "Day")[, "ppt"]
- obs <- dbW_df_day[, "PPT_cm"]
- expect_equal(sim, obs, info = info1)
-
- # Tmin
- sim <- slot(slot(rd, "TEMP"), "Day")[, "min_C"]
- obs <- dbW_df_day[, "Tmin_C"]
- expect_equal(sim, obs, info = info1)
-
- # Tmax
- sim <- slot(slot(rd, "TEMP"), "Day")[, "max_C"]
- obs <- dbW_df_day[, "Tmax_C"]
- expect_equal(sim, obs, info = info1)
- }
+ # Check that input weather is identical to output weather
+ # (don't check missing days that the weather generator filled in)
+ is_obs <- complete.cases(dbW_df_day)
+
+ # Precipitation
+ expect_equal(
+ slot(slot(rd, "PRECIP"), "Day")[is_obs, "ppt"],
+ dbW_df_day[is_obs, "PPT_cm"],
+ info = info1
+ )
+
+ # Tmin
+ expect_equal(
+ slot(slot(rd, "TEMP"), "Day")[is_obs, "min_C"],
+ dbW_df_day[is_obs, "Tmin_C"],
+ info = info1
+ )
+
+ # Tmax
+ expect_equal(
+ slot(slot(rd, "TEMP"), "Day")[is_obs, "max_C"],
+ dbW_df_day[is_obs, "Tmax_C"],
+ info = info1
+ )
# Loop through output
@@ -278,24 +294,25 @@ for (it in tests) {
#--- Test: Compare aggregated daily against yearly output
# Exclusions:
# * "ESTABL" produces only yearly output
- # * SWP is not additive; SOILWAT uses pedotransfer functions
+ # * SWP is not additive; SOILWAT uses soil water release curves
if (all(unlist(has_times))) {
if (fun_agg[k] %in% c("mean", "sum") &&
!(vars[k] %in% c("SWPMATRIC", "ESTABL"))
) {
- res_true <- matrix(TRUE, nrow = rd@yr_nrow, ncol = x1@Columns)
- expect_equivalent({
- nid <- 1:2
- temp1d <- aggregate(
- x1@Day[, -nid],
- by = list(x1@Day[, 1]),
- FUN = fun_agg[k]
- )
- diff1d <- data.matrix(x1@Year[, -1]) - data.matrix(temp1d[, -1])
- abs(diff1d) < tols[["aggregations"]]
- },
- res_true,
+ # Aggregate daily to yearly values
+ nid <- 1:2
+ temp1d <- aggregate(
+ x1@Day[, -nid],
+ by = list(x1@Day[, 1]),
+ FUN = fun_agg[k]
+ )
+
+ # Expect that aggregated daily are equal to SOILWAT2 yearly output
+ expect_equal(
+ data.matrix(temp1d[, -1]),
+ data.matrix(x1@Year[, -1]),
+ tolerance = tols[["aggregations"]],
info = info2
)
}
diff --git a/tests/testthat/test_iOUT_macros.R b/tests/testthat/test_iOUT_macros.R
index 9fa693e0..e21eba07 100644
--- a/tests/testthat/test_iOUT_macros.R
+++ b/tests/testthat/test_iOUT_macros.R
@@ -1,4 +1,3 @@
-context("iOUT macros")
# Consider moving these unit tests to the SOILWAT2-repository once we can
# run unit tests that include `SW_Output.h`
diff --git a/tests/testthat/test_pedotransferfunctions.R b/tests/testthat/test_pedotransferfunctions.R
index d88f0368..946e708e 100644
--- a/tests/testthat/test_pedotransferfunctions.R
+++ b/tests/testthat/test_pedotransferfunctions.R
@@ -1,4 +1,3 @@
-context("Pedotransfer functions: SWP <-> VWC")
# How the functions are applied in rSFSW2
# section: aggregation
@@ -29,32 +28,41 @@ texture <- data.frame(
sand = c(0.92, 0.82, 0.58, 0.43, 0.17, 0.58, 0.32, 0.10, 0.52, 0.06, 0.22),
clay = c(0.03, 0.06, 0.10, 0.18, 0.13, 0.27, 0.34, 0.34, 0.42, 0.47, 0.58)
)
-row.names(texture) <- c("Sand", "Loamy sand", "Sandy loam", "Loam",
+row.names(texture) <- c(
+ "Sand", "Loamy sand", "Sandy loam", "Loam",
"Silty loam", "Sandy clay loam", "Clay loam", "Silty clay loam", "Sandy clay",
- "Silty clay", "Clay")
+ "Silty clay", "Clay"
+)
# Field capacity and agricultural permanent wilting point
+# for Campbell1974 and Cosby1984
swp_fix <- c(fc = -0.0333, pwp = -1.5) # MPa
vwc_fix <- data.frame(
- fc = c(0.103519295200457, 0.138084712513314, 0.210684319180335,
+ fc = c(
+ 0.103519295200457, 0.138084712513314, 0.210684319180335,
0.276327910591054, 0.344767253784927, 0.259008902122202, 0.331526118930414,
- 0.391036796958834, 0.292943352979446, 0.4058577839142, 0.368820489547312),
- pwp = c(0.0325953572147933, 0.05064269086372, 0.0903291990594713,
+ 0.391036796958834, 0.292943352979446, 0.4058577839142, 0.368820489547312
+ ),
+ pwp = c(
+ 0.0325953572147933, 0.05064269086372, 0.0903291990594713,
0.143273427070284, 0.163171562436244, 0.152236773973314, 0.210032386550814,
- 0.248623511289573, 0.196521033130402, 0.282030801991246, 0.269525768616734)
+ 0.248623511289573, 0.196521033130402, 0.282030801991246, 0.269525768616734
+ )
)
row.names(vwc_fix) <- row.names(texture)
ftemp <- file.path("..", "test_data", "swp_values.rds")
if (FALSE) {
- swp_vals <- unlist(
- lapply(
- row.names(texture),
- function(itext) {
- VWCtoSWP(vwc_fix, texture[itext, "sand"], texture[itext, "clay"])
- }
- )
- )
+ swp_vals <- unlist(lapply(
+ row.names(texture),
+ function(itext) {
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix,
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ )
+ }
+ ))
dim(swp_vals) <- c(nrow(vwc_fix), ncol(vwc_fix), nrow(texture))
dimnames(swp_vals) <- list(
row.names(texture),
@@ -68,92 +76,434 @@ if (FALSE) {
}
#--- Tests
-test_that("To SWP", {
- # 1. VWC in fraction [single value] + sand and clay in fraction [single vals]
- # --> SWP in MPa [single value]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(swp_fix[ifix],
- VWCtoSWP(vwc_fix[itext, ifix], texture[itext, "sand"],
- texture[itext, "clay"]))
-
- # 2. VWC in fraction [single value] + sand and clay in fraction
- # [vectors of length d]
- # --> SWP in MPa [vector of length d]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(swp_vals[itext, ifix, ],
- VWCtoSWP(vwc_fix[itext, ifix], texture[, "sand"], texture[, "clay"]))
-
- # 3. VWC in fraction [vector of length l] + sand and clay in fraction
- # [single values]
- # --> SWP in MPa [vector of length l]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(swp_vals[, ifix, itext],
- VWCtoSWP(vwc_fix[, ifix], texture[itext, "sand"], texture[itext, "clay"]))
-
- # 4. VWC in fraction [vector of length l] + sand and clay in fraction
- # [vectors of length d]
- # --> SWP in MPa [matrix with nrow = l and ncol = d, VWC vector repeated
- # for each column]: probably not used
- for (ifix in names(swp_fix))
- expect_equivalent(swp_vals[, ifix, ],
- VWCtoSWP(vwc_fix[, ifix], texture[, "sand"], texture[, "clay"]))
-
- # 5. VWC in fraction [matrix with nrow = l and ncol = d] + sand and clay in
- # fraction [single values]
- # --> SWP in MPa [matrix with nrow = l and ncol = d]
- for (itext in row.names(texture))
- expect_equivalent(swp_vals[, , itext],
- VWCtoSWP(vwc_fix, texture[itext, "sand"], texture[itext, "clay"]))
-
- # 6. VWC in fraction [matrix with nrow = l and ncol = d] + sand and clay in
- # fraction [vectors of length d]
- # --> SWP in MPa [matrix with nrow = l and ncol = d, sand/clay vector
- # repeated for each row]
+test_that("Use SWRC to convert between VWC/SWP", {
+ # 1a. x [len = 1] + soils [len = 1] --> res [len = 1]
+ fcoarse <- rep(0., 1)
+
for (ifix in names(swp_fix)) {
- xin <- matrix(vwc_fix[, ifix], nrow = nrow(vwc_fix), ncol = nrow(texture),
- byrow = TRUE)
- xout <- matrix(swp_fix[ifix], nrow = nrow(vwc_fix), ncol = nrow(texture))
- expect_equivalent(xout,
- VWCtoSWP(xin, texture[, "sand"], texture[, "clay"]))
+ for (itext in row.names(texture)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[itext, ifix],
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ ),
+ swp_fix[ifix],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[itext, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ swp_fix[ifix],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_swp_to_vwc(
+ swp_MPa = swp_fix[ifix],
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ ),
+ vwc_fix[itext, ifix],
+ ignore_attr = c("names", "dimnames")
+ )
+ }
+ }
+
+ # 1b. x [len = l] + soils [len = d] -> res [dim = l = d] where l = d
+ fcoarse <- rep(0., nrow(texture))
+
+ for (ifix in names(swp_fix)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ sand = texture[, "sand"],
+ clay = texture[, "clay"]
+ ),
+ diag(swp_vals[, ifix, ]),
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[, "sand"],
+ clay = texture[, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ diag(swp_vals[, ifix, ]),
+ ignore_attr = c("names", "dimnames")
+ )
+ }
+
+
+ # 2. x [len = 1] + soils [len = d] --> res [len = d]
+ fcoarse <- rep(0., nrow(texture))
+
+ for (ifix in names(swp_fix)) {
+ for (itext in row.names(texture)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[itext, ifix],
+ sand = texture[, "sand"],
+ clay = texture[, "clay"]
+ ),
+ swp_vals[itext, ifix, ],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[itext, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[, "sand"],
+ clay = texture[, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ swp_vals[itext, ifix, ],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_swp_to_vwc(
+ swp_MPa = swp_fix[ifix],
+ sand = texture[, "sand"],
+ clay = texture[, "clay"]
+ ),
+ unname(vwc_fix[, ifix])
+ )
+ }
+ }
+
+
+ # 3. x [len = l] + soils [len = 1] --> res [len = l]
+ fcoarse <- rep(0., 1)
+
+ for (ifix in names(swp_fix)) {
+ for (itext in row.names(texture)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ ),
+ swp_vals[, ifix, itext],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ swp_vals[, ifix, itext],
+ ignore_attr = c("names", "dimnames")
+ )
+
+ expect_equal(
+ swrc_swp_to_vwc(
+ swp_MPa = rep(swp_fix[ifix], nrow(texture)),
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ ),
+ rep(unname(vwc_fix[itext, ifix]), nrow(texture))
+ )
+ }
+ }
+
+
+ # 4a. x [len = l] + soils [len = d] -> res [dim = l x d] where l != d
+ # (x vector repeated for each soil): probably not used
+ fcoarse <- rep(0., nrow(texture) - 1L)
+
+ for (ifix in names(swp_fix)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ sand = texture[-1, "sand"],
+ clay = texture[-1, "clay"]
+ ),
+ unname(swp_vals[, ifix, -1])
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[-1, "sand"],
+ clay = texture[-1, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ swp_vals[, ifix, -1],
+ ignore_attr = c("names", "dimnames")
+ )
+ }
+
+ # 4b. x [len = l] + soils [len = d] -> res [dim = l x d] where l = d
+ # (x vector repeated for each soil): probably not used
+ fcoarse <- rep(0., nrow(texture))
+
+ for (ifix in names(swp_fix)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ sand = texture[, "sand"],
+ clay = texture[, "clay"],
+ outer_if_equalsize = TRUE
+ ),
+ unname(swp_vals[, ifix, ])
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix[, ifix],
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[, "sand"],
+ clay = texture[, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ ),
+ outer_if_equalsize = TRUE
+ ),
+ swp_vals[, ifix, ],
+ ignore_attr = c("names", "dimnames")
+ )
+ }
+
+ # 5. x [dim = l x d] + soils [len = 1] --> res [dim = l x d]
+ fcoarse <- rep(0., 1)
+
+ for (itext in row.names(texture)) {
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix,
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"]
+ ),
+ unname(swp_vals[, , itext])
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc_fix,
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[itext, "sand"],
+ clay = texture[itext, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ swp_vals[, , itext],
+ ignore_attr = c("names", "dimnames")
+ )
+ }
+
+ # 6. x [dim = l x d] + soils [len = d] --> res [dim = l x d]
+ # (soils vectors repeated for each row of x)
+ fcoarse <- rep(0., nrow(texture))
+
+ for (ifix in names(swp_fix)) {
+ vwc <- matrix(
+ vwc_fix[, ifix],
+ nrow = nrow(vwc_fix) - 1,
+ ncol = nrow(texture),
+ byrow = TRUE
+ )
+ res_expected <- matrix(
+ swp_fix[ifix],
+ nrow = nrow(vwc_fix) - 1,
+ ncol = nrow(texture)
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc,
+ sand = texture[, "sand"],
+ clay = texture[, "clay"]
+ ),
+ res_expected
+ )
+
+ expect_equal(
+ swrc_vwc_to_swp(
+ vwcBulk = vwc,
+ fcoarse = fcoarse,
+ swrc = list(
+ swrc_name = "Campbell1974",
+ swrcp = ptf_estimate(
+ sand = texture[, "sand"],
+ clay = texture[, "clay"],
+ fcoarse = fcoarse,
+ swrc_name = "Campbell1974",
+ ptf_name = "Cosby1984AndOthers"
+ )
+ )
+ ),
+ res_expected,
+ ignore_attr = c("names", "dimnames")
+ )
}
})
-test_that("To VWC", {
- # 1. SWP in MPa [single value] + sand and clay in fraction [single values]
- # --> VWC in fraction [single value]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(vwc_fix[itext, ifix],
- SWPtoVWC(swp_fix[ifix], texture[itext, "sand"], texture[itext, "clay"]))
-
- # 2. SWP in MPa [single value] + sand and clay in fraction
- # [vectors of length d]
- # --> VWC in fraction [vector of length d]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(vwc_fix[, ifix],
- SWPtoVWC(swp_fix[ifix], texture[, "sand"], texture[, "clay"]))
-
- # 3. SWP in MPa [vector of length l] + sand and clay in fraction
- # [single values]
- # --> VWC in fraction [vector of length l]
- for (ifix in names(swp_fix)) for (itext in row.names(texture))
- expect_equivalent(
- SWPtoVWC(rep(swp_fix[ifix], nrow(texture)), texture[itext, "sand"],
- texture[itext, "clay"]),
- rep(vwc_fix[itext, ifix], nrow(texture)))
-
- # 4. SWP in MPa [vector of length l] + sand and clay in fraction
- # [vectors of length d]
- # --> VWC in fraction [matrix with nrow = l and ncol = d, SWP vector
- # repeated for each column]: probably not used
-
- # 5. SWP in MPa [matrix with nrow = l and ncol = d] + sand and clay in
- # fraction [single values]
- # --> VWC in fraction [matrix with nrow = l and ncol = d]
-
- # 6. SWP in MPa [matrix with nrow = l and ncol = d] + sand and clay in
- # fraction [vectors of length d]
- # --> VWC in fraction [matrix with nrow = l and ncol = d, sand/clay vector
- # repeated for each row]
+test_that("Simulate with all SWRC/PTF combinations", {
+ list_swrcs_ptfs <- unname(as.list(as.data.frame(t(
+ rSOILWAT2::list_matched_swrcs_ptfs()
+ ))))
+ dir_test_data <- file.path("..", "test_data")
+ tmp <- list.files(dir_test_data, pattern = "Ex")
+ tmp <- sapply(strsplit(tmp, "_", fixed = TRUE), function(x) x[[1]])
+ tests <- unique(tmp)
+ expect_gt(length(tests), 0)
+
+
+ #--- Loop over test cases ------
+ for (it in tests[1]) {
+ #---INPUTS
+ sw_weather <- readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
+ sw_input <- readRDS(file.path(dir_test_data, paste0(it, "_input.rds")))
+
+ # Just simulate for a few years to speed things up
+ rSOILWAT2::swYears_EndYear(sw_input) <-
+ rSOILWAT2::swYears_StartYear(sw_input) + 5
+
+
+ #--- Loop over SWRC-PTF combinations ------
+ for (isp in seq_along(list_swrcs_ptfs)) {
+
+ # Set SWRC/PTF
+ rSOILWAT2::swSite_SWRCflags(sw_input) <- list_swrcs_ptfs[[isp]]
+
+ # Run SOILWAT
+ x0 <- try(
+ rSOILWAT2::sw_exec(
+ inputData = sw_input,
+ weatherList = sw_weather,
+ echo = FALSE,
+ quiet = TRUE
+ ),
+ silent = TRUE
+ )
+
+
+ if (inherits(x0, "try-error")) {
+ succeed(
+ paste(
+ "No live access to",
+ paste0(list_swrcs_ptfs[[isp]], collapse = "/"),
+ ", skipping for now!"
+ )
+ )
+
+ } else {
+ # Check that we got correct output class
+ expect_s4_class(x0, "swOutput")
+
+
+ #--- Estimate SWRCp and set "has_swrcp" ----
+ sw_input1 <- sw_input
+ soils <- rSOILWAT2::swSoils_Layers(sw_input1)
+
+ rSOILWAT2::swSite_hasSWRCp(sw_input1) <- TRUE
+
+ rSOILWAT2::swSoils_SWRCp(sw_input1) <- rSOILWAT2::ptf_estimate(
+ sand = soils[, "sand_frac"],
+ clay = soils[, "clay_frac"],
+ fcoarse = soils[, "gravel_content"],
+ bdensity = soils[, "bulkDensity_g/cm^3"],
+ swrc_name = list_swrcs_ptfs[[isp]][1],
+ ptf_name = list_swrcs_ptfs[[isp]][2]
+ )
+
+ # Run SOILWAT
+ x1 <- rSOILWAT2::sw_exec(
+ inputData = sw_input1,
+ weatherList = sw_weather,
+ echo = FALSE,
+ quiet = TRUE
+ )
+ expect_s4_class(x1, "swOutput")
+
+
+ #--- Expect simulation output identical independent of
+ # when SWRCp are estimated (before/during `sw_exec()`)
+ vars <- grep(
+ pattern = "version|timestamp",
+ x = slotNames(x1),
+ value = TRUE,
+ invert = TRUE
+ )
+
+ for (sv in vars) {
+ expect_equal(
+ object = slot(x1, !!sv),
+ expected = slot(x0, !!sv),
+ tolerance = rSW2_glovars[["tol"]],
+ info = paste0(
+ it, ": ",
+ paste0(list_swrcs_ptfs[[isp]], collapse = "/"),
+ " - slot ",
+ shQuote(sv)
+ )
+ )
+ }
+ }
+ }
+ }
})
diff --git a/tests/testthat/test_soil_temperature_fails.R b/tests/testthat/test_soil_temperature_fails.R
index 0031070b..cff1cdc1 100644
--- a/tests/testthat/test_soil_temperature_fails.R
+++ b/tests/testthat/test_soil_temperature_fails.R
@@ -1,49 +1,56 @@
-context("rSOILWAT2 soil temperature instability")
#---CONSTANTS
dir_test_data <- file.path("..", "test_data")
temp <- list.files(dir_test_data, pattern = "Ex")
temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
tests <- unique(temp)
-test_that("Test data availability", expect_gt(length(tests), 0))
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
-st_name <- rSW2_glovars[["kSOILWAT2"]][["OutKeys"]][["SW_SOILTEMP"]]
-format_badData <- function(data, ids_bad) {
- if (any(ids_bad)) {
- paste(
- apply(round(data[ids_bad, ], 2), 1, paste, collapse = "/"),
- collapse = "; "
- )
- } else {
- "all good"
+
+test_that("Check soil temperature", {
+ st_name <- rSW2_glovars[["kSOILWAT2"]][["OutKeys"]][["SW_SOILTEMP"]]
+
+ format_badData <- function(data, ids_bad) {
+ if (any(ids_bad)) {
+ paste(
+ apply(round(data[ids_bad, ], 2), 1, paste, collapse = "/"),
+ collapse = "; "
+ )
+ } else {
+ "all good"
+ }
}
-}
-for (it in tests) {
- #---INPUTS
- sw_input <- readRDS(file.path(dir_test_data, paste0(it, "_input.rds")))
- sw_weather <- readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
+ for (it in tests) {
+ #---INPUTS
+ sw_input <- readRDS(file.path(dir_test_data, paste0(it, "_input.rds")))
+ sw_weather <- readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
- #---TESTS
- test_that("Check weather", {
+ #---Check weather
dbW_df_day <- dbW_weatherData_to_dataframe(sw_weather)
info <- paste("test-data", it)
expect_true(all(dbW_df_day[, "Tmin_C"] > -100, na.rm = TRUE), info = info)
expect_true(all(dbW_df_day[, "Tmax_C"] < +100, na.rm = TRUE), info = info)
- })
- test_that("Check soil temperature", {
# Run SOILWAT
- rd <- sw_exec(inputData = sw_input, weatherList = sw_weather,
- echo = FALSE, quiet = TRUE)
+ rd <- sw_exec(
+ inputData = sw_input,
+ weatherList = sw_weather,
+ echo = FALSE,
+ quiet = TRUE
+ )
expect_s4_class(rd, "swOutput")
expect_false(has_soilTemp_failed())
Tsoil_data <- slot(rd, st_name)
- time_steps <- rSW2_glovars[["sw_TimeSteps"]][1 + Tsoil_data@TimeStep]
+ time_steps <- rSW2_glovars[["kSOILWAT2"]][["OutPeriods"]][
+ 1 + Tsoil_data@TimeStep
+ ]
for (k in seq_along(time_steps)) {
info <- paste("test-data", it, "- slot", time_steps[k])
@@ -85,9 +92,8 @@ for (it in tests) {
)
)
}
- })
-}
-
+ }
+})
#--- Check that min <= avg <= max soil temperature ------
diff --git a/tests/testthat/test_testInputs.R b/tests/testthat/test_testInputs.R
new file mode 100644
index 00000000..28f21539
--- /dev/null
+++ b/tests/testthat/test_testInputs.R
@@ -0,0 +1,86 @@
+
+#------ Check that test inputs conform to specifications ------
+# see data-raw/prepare_testInput_objects.R
+
+dir_test_data <- file.path("..", "test_data")
+temp <- list.files(dir_test_data, pattern = "Ex")
+temp <- sapply(strsplit(temp, "_", fixed = TRUE), function(x) x[[1]])
+tests <- unique(temp)
+
+test_that("Test data availability", {
+ expect_gt(length(tests), 0)
+})
+
+
+test_that("Check example data", {
+ swmiss <- rSW2_glovars[["kSOILWAT2"]][["kNUM"]][["SW_MISSING"]]
+
+ for (it in tests) {
+ sw_input <- readRDS(file.path(dir_test_data, paste0(it, "_input.rds")))
+ dailyInputFlags <- slot(slot(sw_input, "weather"), "dailyInputFlags")
+ sw_weather <- readRDS(file.path(dir_test_data, paste0(it, "_weather.rds")))
+ sw_weather_df <- dbW_weatherData_to_dataframe(sw_weather)
+ sw_wactive_df <- sw_weather_df[
+ ,
+ c(1:2, 2L + which(dailyInputFlags)),
+ drop = FALSE
+ ]
+
+ yrs_sim <- seq(swYears_StartYear(sw_input), swYears_EndYear(sw_input))
+ yrs_wth <- get_years_from_weatherData(sw_weather)
+
+
+ #--- Check that weather is (not) missing (for 'active' inputs) ------
+ if (it != "Ex2") {
+ # not missing: no NAs, no SW_MISSING, all years
+ expect_identical(sum(is.na(sw_wactive_df)), 0L)
+ expect_identical(sum(sw_wactive_df == swmiss), 0L)
+ expect_true(all(yrs_sim %in% yrs_wth))
+
+ } else {
+ # missing: NAs, SW_MISSING, or not all years
+ expect_true(
+ sum(is.na(sw_wactive_df)) > 0 ||
+ sum(sw_wactive_df == swmiss) > 0 ||
+ !all(yrs_sim %in% yrs_wth)
+ )
+ }
+
+
+ #--- Check that weather generator is turned off/on ------
+ if (it != "Ex2") {
+ expect_false(swWeather_UseMarkov(sw_input))
+ } else {
+ expect_true(swWeather_UseMarkov(sw_input))
+ }
+
+
+ #--- Check that soil temperature turned on ------
+ expect_true(swSite_SoilTemperatureFlag(sw_input))
+
+
+ #--- Check that CO2-effects are turned on ------
+ expect_true(as.logical(swCarbon_Use_Bio(sw_input)))
+ expect_true(as.logical(swCarbon_Use_WUE(sw_input)))
+
+
+ #--- Check that surface is flat/tilted ------
+ if (it != "Ex5") {
+ # flat: slope == 0 || aspect: NA, 999
+ expect_true(
+ isTRUE(all.equal(
+ swSite_IntrinsicSiteParams(sw_input)[["Slope"]],
+ 0
+ )) ||
+ swSite_IntrinsicSiteParams(sw_input)[["Aspect"]] %in% c(NA, swmiss)
+ )
+ } else {
+ # tilted: slope > 0 && aspect: not NA, not 999
+ expect_gt(swSite_IntrinsicSiteParams(sw_input)[["Slope"]], 0L)
+ expect_false(
+ swSite_IntrinsicSiteParams(sw_input)[["Aspect"]] %in% c(NA, swmiss)
+ )
+ }
+
+ }
+})
diff --git a/tests/testthat/test_version.R b/tests/testthat/test_version.R
index aad6ac95..bd5ebc9b 100644
--- a/tests/testthat/test_version.R
+++ b/tests/testthat/test_version.R
@@ -1,4 +1,3 @@
-context("rSOILWAT2 object version tags")
#---TESTS
test_that("rSOILWAT2 object versions", {
@@ -92,14 +91,24 @@ test_that("rSOILWAT2 object versions", {
)
- #--- Check for other object classes (ANY-method): return `NA`
- expect_equal(get_version(), NA)
- expect_equal(get_version(NA), NA)
- expect_equal(get_version(NULL), NA)
- expect_equal(get_version(1), NA)
- expect_equal(get_version(list()), NA)
- expect_equal(get_version(try(stop("error"), silent = TRUE)), NA)
- expect_equal(get_version(swSoils_Layers(sw_in)), NA)
+ #--- Check that numeric versions are passed through
+ v <- as.numeric_version(getNamespaceVersion("rSOILWAT2"))
+ expect_identical(get_version(v), as.character(v))
+ v <- packageVersion("base")
+ expect_identical(get_version(v), as.character(v))
+
+
+ #--- Check for other object classes (ANY-method): return `NA_character_`
+ expect_identical(get_version(), NA_character_)
+ expect_identical(get_version(NA), NA_character_)
+ expect_identical(get_version(NULL), NA_character_)
+ expect_identical(get_version(1), NA_character_)
+ expect_identical(get_version(list()), NA_character_)
+ expect_identical(
+ get_version(try(stop("error"), silent = TRUE)),
+ NA_character_
+ )
+ expect_identical(get_version(swSoils_Layers(sw_in)), NA_character_)
expect_false(check_version(NA))
})
@@ -120,14 +129,14 @@ test_that("rSOILWAT2 object timestamps", {
expect_gt(format_timestamp(sw_out), t)
- #--- Check for other object classes (ANY-method): return `NA`
- expect_equal(get_timestamp(), NA)
- expect_equal(get_timestamp(NA), NA)
- expect_equal(get_timestamp(NULL), NA)
- expect_equal(get_timestamp(1), NA)
- expect_equal(get_timestamp(list()), NA)
- expect_equal(get_timestamp(try(stop("error"), silent = TRUE)), NA)
- expect_equal(get_timestamp(swSoils_Layers(sw_in)), NA)
+ #--- Check for other object classes (ANY-method): return `NA_real_`
+ expect_equal(get_timestamp(), NA_real_)
+ expect_equal(get_timestamp(NA), NA_real_)
+ expect_equal(get_timestamp(NULL), NA_real_)
+ expect_equal(get_timestamp(1), NA_real_)
+ expect_equal(get_timestamp(list()), NA_real_)
+ expect_equal(get_timestamp(try(stop("error"), silent = TRUE)), NA_real_)
+ expect_equal(get_timestamp(swSoils_Layers(sw_in)), NA_real_)
expect_equal(format_timestamp(NA), as.POSIXct(NA))
})
diff --git a/tools/test_SWRCs_and_PDFs_Simulations.R b/tools/test_SWRCs_and_PDFs_Simulations.R
new file mode 100644
index 00000000..ab9e446b
--- /dev/null
+++ b/tools/test_SWRCs_and_PDFs_Simulations.R
@@ -0,0 +1,196 @@
+#--- Compare SOILWAT2 simulations under varying SWRCs and PTFs ------
+
+# This script runs SOILWAT2 simulations (using the package default dataset)
+# * for each implemented pair of SWRC/PTF
+# * for default and 50% reduced precipitation events
+#
+# and produced time-series plots by soil layer and by year of
+# volumetric water content (VWC), soil water potential (SWP), and transpiration
+
+
+# Required packages not part of `rSOILWAT2`
+stopifnot(requireNamespace("ggplot2"))
+
+
+#--- List of (available) SWRC-PTF combinations ------
+list_swrcs_ptfs <- unname(as.list(as.data.frame(t(
+ rSOILWAT2::list_matched_swrcs_ptfs()
+))))
+
+tmp <- check_ptf_availability(sapply(list_swrcs_ptfs, `[`, j = 2))
+list_swrcs_ptfs <- list_swrcs_ptfs[tmp]
+
+if (!all(tmp)) {
+ message(
+ "Unavailable PTFs are skipped: ",
+ toString(shQuote(names(tmp)[!tmp]))
+ )
+}
+
+
+#--- Settings ------
+list_plot_vars <- list(
+ list(slot = "SWPMATRIC", var = "SWP [MPa]", trans = function(x) -0.1 * x),
+ list(slot = "VWCBULK", var = "VWC [cm / cm]", trans = function(x) x),
+ list(slot = "TRANSP", var = "Transpiration [mm]", trans = function(x) 10 * x)
+)
+
+nsoils_used <- Inf
+nyears_used <- 10
+fadj_ppts <- c(0.5, 1)
+
+soiltxtcls <- data.frame(
+ sand_frac = c(
+ 0.92, 0.82, 0.58, 0.43, 0.17, 0.58, 0.32, 0.1, 0.52, 0.06, 0.22
+ ),
+ clay_frac = c(
+ 0.03, 0.06, 0.1, 0.18, 0.13, 0.27, 0.34, 0.34, 0.42, 0.47, 0.58
+ ),
+ `bulkDensity_g/cm^3` = c(
+ 1.614, 1.482, 1.520, 1.246, 1.464, 1.700, 1.143, 1.384, 1.26, 1.437, 1.277
+ ),
+ gravel_content = 0,
+ check.names = FALSE
+)
+rownames(soiltxtcls) <- gsub(
+ " ",
+ "-",
+ c(
+ "Sand", "Loamy sand", "Sandy loam", "Loam", "Silty loam", "Sandy clay loam",
+ "Clay loam", "Silty clay loam", "Sandy clay", "Silty clay", "Clay"
+ )
+)
+
+
+#--- Loop over precipitation adjustments ------
+for (k0a in seq_along(fadj_ppts)) {
+
+ #--- Loop over soil texture classes ------
+ for (k0b in seq_len(nrow(soiltxtcls))) {
+
+ #--- Simulate ------
+ soils <- rSOILWAT2::swSoils_Layers(rSOILWAT2::sw_exampleData)
+ nsoils <- nrow(soils)
+ nsoils_used2 <- min(nsoils_used, nsoils)
+ for (k0bi in seq_len(ncol(soiltxtcls))) {
+ soils[, colnames(soiltxtcls)[k0bi]] <- soiltxtcls[k0b, k0bi]
+ }
+
+ year_start <- rSOILWAT2::swYears_StartYear(rSOILWAT2::sw_exampleData)
+
+ swout <- lapply(
+ list_swrcs_ptfs,
+ function(sp) {
+ sw_in <- rSOILWAT2::sw_exampleData
+ rSOILWAT2::swSoils_Layers(sw_in) <- soils
+ rSOILWAT2::swWeather_MonScalingParams(sw_in)[, "PPT"] <- fadj_ppts[k0a]
+ rSOILWAT2::swSite_SWRCflags(sw_in) <- sp
+ rSOILWAT2::sw_exec(inputData = sw_in)
+ }
+ )
+
+
+ #--- Create figures ------
+ for (k1 in seq_along(list_plot_vars)) {
+
+ fname_fig <- file.path(
+ ".",
+ paste0(
+ "Fig_SOILWAT2_SWRCs-PTFs_Simulation-Run_",
+ "_Soil-", rownames(soiltxtcls)[k0b],
+ "_PPT", round(100 * fadj_ppts[k0a]), "pct",
+ "__response-", list_plot_vars[[k1]][["slot"]],
+ ".pdf"
+ )
+ )
+
+ if (file.exists(fname_fig)) next
+
+ #--- * Prepare data ------
+ tmp_swout <- mapply(
+ function(x, sp) {
+ tmp <- slot(slot(x, list_plot_vars[[k1]][["slot"]]), "Day")
+ res <- data.frame(
+ SWRC = sp[1],
+ PTF = sp[2],
+ tmp[, c("Year", "Day")],
+ date = as.Date(
+ paste(tmp[, "Year"], tmp[, "Day"], sep = "-"),
+ format = "%Y-%j"
+ ),
+ list_plot_vars[[k1]][["trans"]](tmp[, 2 + seq_len(nsoils)])
+ )
+ colnames(res) <- gsub("transp_total_", "", colnames(res))
+ res
+ },
+ swout,
+ list_swrcs_ptfs,
+ SIMPLIFY = FALSE
+ )
+
+ var_swout <- reshape(
+ do.call(rbind, tmp_swout),
+ direction = "long",
+ varying = grep("Lyr_", colnames(tmp_swout[[1]]), value = TRUE),
+ sep = "_"
+ )
+
+ # rename "Lyr" to variable name
+ colnames(var_swout)[grep("Lyr", colnames(var_swout))] <-
+ list_plot_vars[[k1]][["var"]]
+
+ # create combined SWRC-PTF name (for coloration)
+ var_swout[, "SWRC-PTF"] <- paste(
+ var_swout[, "SWRC"],
+ var_swout[, "PTF"],
+ sep = "-"
+ )
+
+ # add soil layer depths
+ var_swout[, "Layer"] <- factor(
+ var_swout[, "time"],
+ levels = seq_len(nsoils),
+ labels = paste0(
+ c(0, soils[-nsoils, "depth_cm"]), "-",
+ soils[, "depth_cm"],
+ " cm"
+ )
+ )
+
+ #--- Subset data to requested years and soil layers
+ ids <-
+ var_swout$Year %in% (year_start + seq_len(nyears_used) - 1) &
+ var_swout$time %in% seq_len(nsoils_used2)
+ var_swout_used <- var_swout[ids, , drop = FALSE]
+
+
+ #--- * Create plot ------
+ tmp <- ggplot2::ggplot(var_swout_used) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = Day,
+ y = .data[[list_plot_vars[[k1]][["var"]]]],
+ color = `SWRC-PTF`,
+ linetype = `SWRC-PTF`
+ )
+ ) +
+ ggplot2::facet_wrap(
+ ggplot2::vars(Layer, Year),
+ nrow = nsoils_used2,
+ #scales = "free_y",
+ labeller = ggplot2::label_wrap_gen(multi_line = FALSE)
+ ) +
+ egg::theme_article()
+
+
+ #--- Write to file
+ pdf(
+ file = fname_fig,
+ height = 2.5 * nsoils_used2,
+ width = 3 * (nyears_used + 1)
+ )
+ plot(tmp)
+ dev.off()
+ }
+ }
+}
diff --git a/tools/test_SWRCs_and_PDFs_TheoreticalCurves.R b/tools/test_SWRCs_and_PDFs_TheoreticalCurves.R
new file mode 100644
index 00000000..e7f2de2f
--- /dev/null
+++ b/tools/test_SWRCs_and_PDFs_TheoreticalCurves.R
@@ -0,0 +1,357 @@
+#--- Plot and compare Shape of Soil Water Retention Curves ------
+
+# This script builds theoretical theta-phi (and phi-theta) relationships (SWRCs)
+# * for each implemented pair of SWRC/PTF
+# * for a variety of soil textures
+#
+# and produced plots:
+# (i) to compare curves among soil textures within a SWRC
+# (ii) to compare curves among SWRCs within each soil texture
+
+
+# Required packages not part of `rSOILWAT2`
+stopifnot(requireNamespace("ggplot2"))
+
+
+
+#--- List of (available) SWRC-PTF combinations ------
+list_swrcs_ptfs <- unname(as.list(as.data.frame(t(
+ rSOILWAT2::list_matched_swrcs_ptfs()
+))))
+
+tmp <- check_ptf_availability(sapply(list_swrcs_ptfs, `[`, j = 2))
+list_swrcs_ptfs <- list_swrcs_ptfs[tmp]
+
+if (!all(tmp)) {
+ message(
+ "Unavailable PTFs are skipped: ",
+ toString(shQuote(names(tmp)[!tmp]))
+ )
+}
+
+
+
+#--- Inputs ------
+thetas <- seq(0.00, 0.55, by = 0.001)
+phis <- unique(sort(c(
+ seq(-1000, -4, by = 1),
+ seq(-4, -1, by = 0.1),
+ seq(-1, -0.01, by = 0.01),
+ -0.033,
+ seq(-0.01, 0, by = 0.001),
+ seq(-0.001, 0, by = 0.0001)
+)))
+
+soiltxtcls <- data.frame(
+ sand_frac = c(
+ 0.92, 0.82, 0.58, 0.43, 0.17, 0.58, 0.32, 0.1, 0.52, 0.06, 0.22
+ ),
+ clay_frac = c(
+ 0.03, 0.06, 0.1, 0.18, 0.13, 0.27, 0.34, 0.34, 0.42, 0.47, 0.58
+ ),
+ bd = c(
+ 1.614, 1.482, 1.520, 1.246, 1.464, 1.700, 1.143, 1.384, 1.26, 1.437, 1.277
+ ),
+ fcoarse = 0
+)
+rownames(soiltxtcls) <- gsub(
+ " ",
+ ".",
+ c(
+ "Sand", "Loamy sand", "Sandy loam", "Loam", "Silty loam", "Sandy clay loam",
+ "Clay loam", "Silty clay loam", "Sandy clay", "Silty clay", "Clay"
+ )
+)
+
+
+tag_soils <- paste0("soil__", rownames(soiltxtcls))
+
+
+#--- Estimate SWRCp ------
+swrcps <- lapply(
+ list_swrcs_ptfs,
+ function(sp){
+ rSOILWAT2::ptf_estimate(
+ sand = soiltxtcls[, "sand_frac"],
+ clay = soiltxtcls[, "clay_frac"],
+ bdensity = soiltxtcls[, "bd"],
+ fcoarse = soiltxtcls[, "fcoarse"],
+ swrc_name = sp[1],
+ ptf_name = sp[2]
+ )
+ }
+)
+
+
+#--- Calculate phi ------
+phi_sim <- mapply(
+ function(sp, ps) {
+ rSOILWAT2::swrc_vwc_to_swp(
+ thetas,
+ swrc = list(name = sp[1], swrcp = ps)
+ )
+ },
+ list_swrcs_ptfs,
+ swrcps,
+ SIMPLIFY = FALSE
+)
+
+
+
+#--- * Prepare calculated phi ------
+tmp <- mapply(
+ function(sp, theta, phi) {
+ data.frame(
+ SWRC = sp[1],
+ PTF = sp[2],
+ `SWRC-PTF` = paste(sp, collapse = "-"),
+ theta = theta,
+ {
+ colnames(phi) <- tag_soils
+ phi
+ }
+ )
+ },
+ list_swrcs_ptfs,
+ lapply(seq_along(list_swrcs_ptfs), function(k) thetas),
+ phi_sim,
+ SIMPLIFY = FALSE
+)
+
+x_phi <- reshape(
+ do.call(rbind, tmp),
+ direction = "long",
+ varying = tag_soils,
+ sep = "__"
+)
+
+# beautify
+x_phi[, "time"] <- gsub(".", " ", x_phi[, "time"], fixed = TRUE)
+colnames(x_phi)[colnames(x_phi) == "time"] <- "soil texture"
+colnames(x_phi)[colnames(x_phi) == "soil"] <- "phi"
+colnames(x_phi)[colnames(x_phi) == "SWRC.PTF"] <- "SWRC-PTF"
+
+
+
+
+#--- * Figure of phi: compare curves among soil textures within a SWRC ------
+fname1 <- file.path("Fig_SOILWAT2_SWRCs-PTFs_Curves-phi_SoilTextures.pdf")
+
+if (!file.exists(fname1)) {
+ tmp <- ggplot2::ggplot(x_phi) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = theta,
+ y = -phi,
+ color = `soil texture`,
+ linetype = `soil texture`
+ )
+ ) +
+ ggplot2::geom_hline(
+ yintercept = c(0.033, 1.5, 30),
+ color = "gray",
+ linetype = "dotted"
+ ) +
+ ggplot2::facet_wrap(ggplot2::vars(`SWRC-PTF`)) +
+ ggplot2::scale_y_log10(limits = c(1e-4, 1e3)) +
+ ggplot2::xlab(Volumetric~Water~Content~~(cm^3/cm^3)) +
+ ggplot2::ylab(Matric~~Potential~~(-MPa)) +
+ egg::theme_article()
+
+
+ #--- Write to file
+ npanels <- apply(
+ unique(ggplot2::ggplot_build(tmp)$layout$layout[, c("ROW", "COL")]),
+ 2,
+ max
+ )
+
+ pdf(
+ file = fname1,
+ height = 4 * npanels[1],
+ width = 5 * (npanels[2] + 0.5)
+ )
+ plot(tmp)
+ dev.off()
+}
+
+
+
+#--- * Figure of phi: compare curves among SWRCs within each soil texture ------
+fname2 <- file.path(".", "Fig_SOILWAT2_SWRCs-PTFs_Curves-phi_SWRCs.pdf")
+
+if (!file.exists(fname2)) {
+ tmp <- ggplot2::ggplot(x_phi) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = theta,
+ y = -phi,
+ color = `SWRC-PTF`,
+ linetype = `SWRC-PTF`
+ )
+ ) +
+ ggplot2::geom_hline(
+ yintercept = c(0.033, 1.5, 30),
+ color = "gray",
+ linetype = "dotted"
+ ) +
+ ggplot2::facet_wrap(ggplot2::vars(`soil texture`)) +
+ ggplot2::scale_y_log10(limits = c(1e-4, 1e3)) +
+ ggplot2::xlab(Volumetric~Water~Content~~(cm^3/cm^3)) +
+ ggplot2::ylab(Matric~~Potential~~(-MPa)) +
+ egg::theme_article()
+
+
+ #--- Write to file
+ npanels <- apply(
+ unique(ggplot2::ggplot_build(tmp)$layout$layout[, c("ROW", "COL")]),
+ 2,
+ max
+ )
+
+ pdf(
+ file = fname2,
+ height = 3 * npanels[1],
+ width = 4 * (npanels[2] + 0.5)
+ )
+ plot(tmp)
+ dev.off()
+}
+
+
+
+
+#--- Calculate theta ------
+theta_sim <- mapply(
+ function(sp, ps) {
+ rSOILWAT2::swrc_swp_to_vwc(
+ phis,
+ swrc = list(name = sp[1], swrcp = ps)
+ )
+ },
+ list_swrcs_ptfs,
+ swrcps,
+ SIMPLIFY = FALSE
+)
+
+
+
+#--- * Prepare calculated theta ------
+tmp <- mapply(
+ function(sp, theta, phi) {
+ data.frame(
+ SWRC = sp[1],
+ PTF = sp[2],
+ `SWRC-PTF` = paste(sp, collapse = "-"),
+ phi = phi,
+ {
+ colnames(theta) <- tag_soils
+ theta
+ }
+ )
+ },
+ list_swrcs_ptfs,
+ theta_sim,
+ lapply(seq_along(list_swrcs_ptfs), function(k) phis),
+ SIMPLIFY = FALSE
+)
+
+x_theta <- reshape(
+ do.call(rbind, tmp),
+ direction = "long",
+ varying = tag_soils,
+ sep = "__"
+)
+
+# beautify
+x_theta[, "time"] <- gsub(".", " ", x_theta[, "time"], fixed = TRUE)
+colnames(x_theta)[colnames(x_theta) == "time"] <- "soil texture"
+colnames(x_theta)[colnames(x_theta) == "soil"] <- "theta"
+colnames(x_theta)[colnames(x_theta) == "SWRC.PTF"] <- "SWRC-PTF"
+
+
+
+
+#--- * Figure of theta: compare curves among soil textures within a SWRC ------
+fname1 <- file.path("Fig_SOILWAT2_SWRCs-PTFs_Curves-theta_SoilTextures.pdf")
+
+if (!file.exists(fname1)) {
+ tmp <- ggplot2::ggplot(x_theta) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = -phi,
+ y = theta,
+ color = `soil texture`,
+ linetype = `soil texture`
+ )
+ ) +
+ ggplot2::geom_vline(
+ xintercept = c(0.033, 1.5, 30),
+ color = "gray",
+ linetype = "dotted"
+ ) +
+ ggplot2::facet_wrap(ggplot2::vars(`SWRC-PTF`)) +
+ ggplot2::scale_x_log10(limits = c(1e-4, 1e3)) +
+ ggplot2::xlab(Matric~~Potential~~(-MPa)) +
+ ggplot2::ylab(Volumetric~Water~Content~~(cm^3/cm^3)) +
+ egg::theme_article()
+
+
+ #--- Write to file
+ npanels <- apply(
+ unique(ggplot2::ggplot_build(tmp)$layout$layout[, c("ROW", "COL")]),
+ 2,
+ max
+ )
+
+ pdf(
+ file = fname1,
+ height = 4 * npanels[1],
+ width = 5 * (npanels[2] + 0.5)
+ )
+ plot(tmp)
+ dev.off()
+}
+
+
+
+#--- * Figure of theta: compare curves among SWRCs within each soil texture ------
+fname2 <- file.path(".", "Fig_SOILWAT2_SWRCs-PTFs_Curves-theta_SWRCs.pdf")
+
+if (!file.exists(fname2)) {
+ tmp <- ggplot2::ggplot(x_theta) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = -phi,
+ y = theta,
+ color = `SWRC-PTF`,
+ linetype = `SWRC-PTF`
+ )
+ ) +
+ ggplot2::geom_vline(
+ xintercept = c(0.033, 1.5, 30),
+ color = "gray",
+ linetype = "dotted"
+ ) +
+ ggplot2::facet_wrap(ggplot2::vars(`soil texture`)) +
+ ggplot2::scale_x_log10(limits = c(1e-4, 1e3)) +
+ ggplot2::xlab(Matric~~Potential~~(-MPa)) +
+ ggplot2::ylab(Volumetric~Water~Content~~(cm^3/cm^3)) +
+ egg::theme_article()
+
+
+ #--- Write to file
+ npanels <- apply(
+ unique(ggplot2::ggplot_build(tmp)$layout$layout[, c("ROW", "COL")]),
+ 2,
+ max
+ )
+
+ pdf(
+ file = fname2,
+ height = 3 * npanels[1],
+ width = 4 * (npanels[2] + 0.5)
+ )
+ plot(tmp)
+ dev.off()
+}
diff --git a/tools/test_dbWeather_Compression.R b/tools/test_dbWeather_Compression.R
index ac9d3c5b..3bd1c56a 100644
--- a/tools/test_dbWeather_Compression.R
+++ b/tools/test_dbWeather_Compression.R
@@ -1,4 +1,3 @@
-context("Test dbWeather compression types")
# Create reference objects
do_benchmark <- FALSE
diff --git a/vignettes/.gitignore b/vignettes/.gitignore
index 7b457acd..ca626478 100644
--- a/vignettes/.gitignore
+++ b/vignettes/.gitignore
@@ -2,3 +2,4 @@
*.pdf
*.R
\.build.timestamp
+*.log
diff --git a/vignettes/rSOILWAT2_WeatherDatabase.Rmd b/vignettes/rSOILWAT2_WeatherDatabase.Rmd
index 59476610..eb9da48d 100644
--- a/vignettes/rSOILWAT2_WeatherDatabase.Rmd
+++ b/vignettes/rSOILWAT2_WeatherDatabase.Rmd
@@ -97,7 +97,7 @@ Here, we create three replicates of our example data with the weather generator
imputation_span = 5
)
- x_empty <- list(new("swWeatherData"))
+ x_empty <- weatherHistory()
# Loop over our three sites, generate weather, and add it to the database
for (k in seq_len(nrow(sites1))) {
diff --git a/vignettes/rSOILWAT2_demo.Rmd b/vignettes/rSOILWAT2_demo.Rmd
index 20c08a55..fbbc2c7d 100644
--- a/vignettes/rSOILWAT2_demo.Rmd
+++ b/vignettes/rSOILWAT2_demo.Rmd
@@ -24,6 +24,9 @@ editor_options:
---
\pagebreak
+```{r, include=FALSE}
+options(tinytex.verbose = TRUE)
+```
# General setup, installation, and R recap
@@ -187,8 +190,8 @@ editor_options:
## Create base rSOILWAT2 input object
```{r, input_object}
# Preferred option:
- # All relevant site-specific paramaters and variables are set to NA
- sw_in <- new("swInputData")
+ # 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
@@ -236,6 +239,8 @@ You may organize weather data in a variety of ways:
### Access external data sets: for example, `DayMet`
```{r, weather_daymetr, results = "hide", message = FALSE, warning = FALSE}
+ has_daymet <- FALSE
+
if (
requireNamespace("daymetr") &&
requireNamespace("curl") &&
@@ -255,38 +260,140 @@ You may organize weather data in a variety of ways:
if (!inherits(dm_Laramie, "try-error")) {
# Convert data to a `rSOILWAT2`-formatted weather object
- vars <- c("year", "yday", "tmax..deg.c.", "tmin..deg.c.", "prcp..mm.day.")
+ dif <- c(rep(TRUE, 3L), rep(FALSE, 11L)) # Tmax, Tmin, PPT
+ dif[13L] <- TRUE # ACTUAL_VP
+ dif[14L] <- TRUE # SHORT_WR, desc_rsds = 2
+
+ vars <- c(
+ "year", "yday",
+ "tmax..deg.c.", "tmin..deg.c.", "prcp..mm.day.",
+ "vp..Pa.",
+ "srad..W.m.2."
+ )
xdf <- dm_Laramie[["data"]][, vars]
xdf[, "prcp..mm.day."] <- xdf[, "prcp..mm.day."] / 10 # convert mm -> cm
- colnames(xdf) <- c("Year", "DOY", "Tmax_C", "Tmin_C", "PPT_cm")
+ xdf[, "vp..Pa."] <- xdf[, "vp..Pa."] / 1000 # convert Pa -> kPa
+ colnames(xdf) <- c(
+ "Year", "DOY",
+ "Tmax_C", "Tmin_C", "PPT_cm", "actVP_kPa", "shortWR"
+ )
+
+ xdf2 <- array(
+ dim = c(nrow(xdf), 2L + length(rSOILWAT2::weather_dataColumns())),
+ dimnames = list(
+ NULL,
+ c("Year", "DOY", rSOILWAT2::weather_dataColumns())
+ )
+ )
+
+ xdf2[, colnames(xdf)] <- as.matrix(xdf)
- wdata_dm <- rSOILWAT2::dbW_dataframe_to_weatherData(weatherDF = xdf)
# Convert `DayMet`'s `noleap` calendar to proleptic Gregorian calendar
- xdf2 <- rSOILWAT2::dbW_convert_to_GregorianYears(weatherData = wdata_dm)
+ xdf3 <- rSOILWAT2::dbW_convert_to_GregorianYears(
+ weatherData = rSOILWAT2::dbW_dataframe_to_weatherData(
+ weatherDF = xdf2[, -1L, drop = FALSE],
+ years = unique(xdf2[, "Year"]),
+ weatherDF_dataColumns = colnames(xdf2)[-1L],
+ round = 4L
+ )
+ )
+
+ # Impute values for added leap days
+ # Use weather generator for available variables, use LOCF otherwise
+ xdf4 <- xdf3
- wdata <- rSOILWAT2::dbW_generateWeather(
- weatherData = rSOILWAT2::dbW_dataframe_to_weatherData(weatherDF = xdf2),
- seed = 123
+ vars_wgen <- rSOILWAT2::weatherGenerator_dataColumns()
+ needs_wgen <- which(
+ !is.finite(as.matrix(xdf4[, vars_wgen, drop = FALSE])),
+ arr.ind = TRUE
)
+ if (NROW(needs_wgen) > 0) {
+ tmp1 <- rSOILWAT2::dbW_generateWeather(
+ weatherData = xdf4,
+ seed = 123
+ )
+ tmp2 <- rSOILWAT2::dbW_weatherData_to_dataframe(tmp1)
+
+ xdf4[, vars_wgen][needs_wgen] <- tmp2[, vars_wgen][needs_wgen]
+ }
+
+ ids_dif <- 2L + which(dif)
+ needs_locf <- which(
+ !is.finite(as.matrix(xdf4[, ids_dif, drop = FALSE])),
+ arr.ind = TRUE
+ )
+ if (NROW(needs_locf) > 0) {
+ tmp1 <- rSW2utils::impute_df(
+ xdf4[, ids_dif, drop = FALSE],
+ imputation_type = "locf"
+ )
+
+ xdf4[, ids_dif][needs_locf] <- tmp1[needs_locf]
+ }
+
+ wdata <- rSOILWAT2::dbW_dataframe_to_weatherData(xdf4, round = 4L)
# Check that weather data is well-formed
stopifnot(rSOILWAT2::dbW_check_weatherData(wdata))
+
+ # Set use flags
+ sw_in@weather@desc_rsds <- 2L # flux density over the daylight period
+ sw_in@weather@use_cloudCoverMonthly <- FALSE # use radiation instead
+ sw_in@weather@use_windSpeedMonthly <- TRUE
+ sw_in@weather@use_humidityMonthly <- FALSE # use vapor pressure instead
+ sw_in@weather@dailyInputFlags <- dif
+
+ has_daymet <- TRUE
}
}
+
+ if (!has_daymet) {
+ # We don't have live internet and
+ # were not able to obtain weather data for requested years
+ # --> instead, use data we have locally and adjust years
+ years <- sapply(wdata, function(x) slot(x, "year"))
+ rSOILWAT2::swYears_StartYear(sw_in) <- 0
+ rSOILWAT2::swYears_EndYear(sw_in) <- max(years)
+ rSOILWAT2::swYears_StartYear(sw_in) <- min(years)
+
+ # Set use flags
+ sw_in@weather@desc_rsds <- 0L
+ sw_in@weather@use_cloudCoverMonthly <- TRUE
+ sw_in@weather@use_windSpeedMonthly <- TRUE
+ sw_in@weather@use_humidityMonthly <- TRUE
+ sw_in@weather@dailyInputFlags <- c(rep(TRUE, 3L), rep(FALSE, 11L))
+ }
```
+### Adjust requested simulation period to available inputs
+This may not be the case if there was no internet connection to download
+data from `DayMet`
+```{r, weather_years}
+ yrs <- rSOILWAT2::get_years_from_weatherData(wdata)
-### Specify first year of observed weather data
-```{r, wyr}
- # `FirstYearHistorical` can be set to a negative value (the default),
- # then the code will use the first simulation year.
- # That is, the two lines below will produce identical simulations:
- rSOILWAT2::swWeather_FirstYearHistorical(sw_in) <-
- rSOILWAT2::swYears_StartYear(sw_in)
- rSOILWAT2::swWeather_FirstYearHistorical(sw_in) <- -1
-```
+ if (rSOILWAT2::swYears_EndYear(sw_in) > max(yrs)) {
+ message(
+ "Insufficient weather data to end simulations in year ",
+ rSOILWAT2::swYears_EndYear(sw_in),
+ ":\nAdjust end of simulation period to year ",
+ max(yrs),
+ "."
+ )
+ rSOILWAT2::swYears_EndYear(sw_in) <- max(yrs)
+ }
+ if (rSOILWAT2::swYears_StartYear(sw_in) < min(yrs)) {
+ message(
+ "Insufficient weather data to start simulations in year ",
+ rSOILWAT2::swYears_StartYear(sw_in),
+ ":\nadjust start of simulation period to year ",
+ min(yrs),
+ "."
+ )
+ rSOILWAT2::swYears_StartYear(sw_in) <- min(yrs)
+ }
+```
### Calculate site climate from daily values
```{r, siteclim}
@@ -308,7 +415,7 @@ You may organize weather data in a variety of ways:
# Assign CO2 values to rSOILWAT2 input object
rSOILWAT2::swCarbon_Scenario(sw_in) <- co2_nametag
- rSOILWAT2::swCarbon_CO2ppm(sw_in) <- data.matrix(co2_data)
+ rSOILWAT2::swCarbon_CO2ppm(sw_in) <- co2_data
```
@@ -463,8 +570,11 @@ You may organize weather data in a variety of ways:
## Assign new soil data to rSOILWAT2 input object
```{r, soils_final1}
+ # NRCS SSURGO `dbovendry` represents the soil density of the matric component
+ rSOILWAT2::swSite_SoilDensityInputType(sw_in) <- 0L
+
# This fails because rooting profile values are still missing
- try(rSOILWAT2::swSoils_Layers(sw_in) <- data.matrix(soil_new))
+ try(rSOILWAT2::swSoils_Layers(sw_in) <- soil_new)
```
@@ -576,7 +686,36 @@ You may organize weather data in a variety of ways:
## Assign new soil data to rSOILWAT2 input object
```{r, soils_final2, results = "hide"}
- rSOILWAT2::swSoils_Layers(sw_in) <- data.matrix(soil_new)
+ rSOILWAT2::swSoils_Layers(sw_in) <- soil_new
+```
+
+
+## Estimate parameters of Soil Water Retention Curve before simulation
+Note: This step is usually not necessarily;
+instead, the default setup is that parameters are estimated automatically
+by `SOILWAT2` with the selected pedotransfer function.
+```{r, soils_swrc}
+ tmp <- rSOILWAT2::swSite_SWRCflags(sw_in)
+ swrcp <- rSOILWAT2::ptf_estimate(
+ sand = soil_new[, "sand_frac"],
+ clay = soil_new[, "clay_frac"],
+ fcoarse = soil_new[, "gravel_content"],
+ bdensity = soil_new[, "bulkDensity_g.cm.3"],
+ swrc_name = tmp["swrc_name"],
+ ptf_name = tmp["ptf_name"]
+ )
+
+
+ # Set estimated `SWRC` parameter values
+ rSOILWAT2::swSoils_SWRCp(sw_in) <- swrcp
+
+ # 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)
+ }
```
@@ -591,7 +730,7 @@ You may organize weather data in a variety of ways:
tr_lyrs_10cm <- c(1, 1, 1, 2, 2, 2, 2, 3, 3, 3)
tr <- rSOILWAT2::prepare_TranspirationRegions(tr_lyrs = tr_lyrs_10cm)
- rSOILWAT2::swSite_TranspirationRegions(sw_in) <- data.matrix(tr)
+ rSOILWAT2::swSite_TranspirationRegions(sw_in) <- tr
# Make necessary adjustments based on soil depth and rooting profiles
rSOILWAT2::swSite_TranspirationRegions(sw_in) <-
@@ -617,9 +756,18 @@ You may organize weather data in a variety of ways:
## Run SOILWAT2 for prepared site
+Note: Knitting vignette crashes with C-level messages -> run quietly
```{r, run_site}
- sw_out <- rSOILWAT2::sw_exec(inputData = sw_in, weatherList = wdata)
- sw_out2 <- rSOILWAT2::sw_exec(inputData = sw_in2, weatherList = wdata)
+ sw_out <- rSOILWAT2::sw_exec(
+ inputData = sw_in,
+ weatherList = wdata,
+ quiet = TRUE
+ )
+ sw_out2 <- rSOILWAT2::sw_exec(
+ inputData = sw_in2,
+ weatherList = wdata,
+ quiet = TRUE
+ )
```
@@ -665,7 +813,10 @@ You may organize weather data in a variety of ways:
(iii) run SOILWAT2 with filled-in data
```{r, weather3}
- wgen_coeffs <- rSOILWAT2::dbW_estimate_WGen_coefs(weatherData = wdata)
+ wgen_coeffs <- rSOILWAT2::dbW_estimate_WGen_coefs(
+ weatherData = wdata,
+ imputation_type = "locf"
+ )
wdata_filled <- rSOILWAT2::dbW_generateWeather(
weatherData = wdata_gaps,