From b62c59e2936cb3db5ff5203d197ddf1656d4b59a Mon Sep 17 00:00:00 2001 From: Daniel Falster Date: Sun, 2 Jun 2024 19:09:53 +1000 Subject: [PATCH] Reduce the number of exported functions (#420) These functions were exported but aren't really used and add clutter Towards #206 #399 --- .Rbuildignore | 1 + DESCRIPTION | 3 +- NAMESPACE | 58 +------- R/RcppR6.R | 4 +- R/bounds.R | 143 -------------------- R/ff16.R | 46 +------ R/ff16r.R | 46 +------ R/ff16w.R | 47 +------ R/individual.R | 5 +- R/k93.R | 50 +------ R/scm_support.R | 2 + R/stochastic.R | 4 +- R/tf24.R | 46 +------ R/util.R | 92 +------------ R/util_model.R | 32 +---- R/util_solve.R | 70 ---------- inst/RcppR6_classes.yml | 2 - man/FF16.Rd | 25 +--- man/FF16_test_environment.Rd | 2 +- man/FF16r.Rd | 25 +--- man/FF16r_test_environment.Rd | 2 +- man/FF16w.Rd | 25 +--- man/FF16w_test_environment.Rd | 2 +- man/K93.Rd | 25 +--- man/K93_test_environment.Rd | 2 +- man/bounds.Rd | 36 ----- man/clamp_domain.Rd | 27 ---- man/make_transparent.Rd | 20 --- man/nlsolve.Rd | 24 ---- man/rbind_list.Rd | 17 --- man/splinefun_log.Rd | 26 ---- man/strategy_list.Rd | 16 +-- man/util_colour_set_opacity.Rd | 20 +++ man/validate.Rd | 1 + pkgdown/_pkgdown.yml | 21 ++- tests/testthat/helper-plant.R | 10 +- tests/testthat/test-birth-rate-splines.r | 4 +- tests/testthat/test-individual-utils.R | 15 +- tests/testthat/test-individual.R | 9 +- tests/testthat/test-internals.R | 8 +- tests/testthat/test-node-schedule.R | 22 +-- tests/testthat/test-ode-control.R | 2 +- tests/testthat/test-ode-individual-runner.R | 2 +- tests/testthat/test-parameters.R | 6 +- tests/testthat/test-qag.R | 3 + tests/testthat/test-scm.R | 2 +- tests/testthat/test-strategy-ff16.R | 4 +- tests/testthat/test-strategy-tf24.R | 4 +- tests/testthat/test-utils.R | 15 -- vignettes/emergent.Rmd | 55 +++++++- vignettes/extrinsic_drivers.Rmd | 8 +- vignettes/individuals.Rmd | 15 +- vignettes/models/strategy_K93.Rmd | 2 +- vignettes/parameters.Rmd | 11 +- vignettes/patch.Rmd | 14 +- vignettes/strategy_new.Rmd | 2 +- 56 files changed, 177 insertions(+), 1003 deletions(-) delete mode 100644 R/bounds.R delete mode 100644 R/util_solve.R delete mode 100644 man/bounds.Rd delete mode 100644 man/clamp_domain.Rd delete mode 100644 man/make_transparent.Rd delete mode 100644 man/nlsolve.Rd delete mode 100644 man/rbind_list.Rd delete mode 100644 man/splinefun_log.Rd create mode 100644 man/util_colour_set_opacity.Rd delete mode 100644 tests/testthat/test-utils.R diff --git a/.Rbuildignore b/.Rbuildignore index 98551e44..225f8bbd 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -36,5 +36,6 @@ ^vignettes/package_organisation.Rmd$ ^vignettes/parameters.Rmd$ ^vignettes/patch.Rmd$ +^vignettes/profiling_code.Rmd$ ^vignettes/self_thinning.Rmd$ ^vignettes/strategy_new.Rmd$ diff --git a/DESCRIPTION b/DESCRIPTION index 1b4b4477..14208eef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,6 @@ Suggests: here, deSolve, numDeriv, - parallel, RcppR6 (>= 0.2.3), knitr, rmarkdown, @@ -57,4 +56,4 @@ Remotes: VignetteBuilder: knitr URL: https://github.com/traitecoevo/plant BugReports: https://github.com/traitecoevo/plant/issues -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NAMESPACE b/NAMESPACE index fc68df57..a6004a41 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,67 +1,33 @@ # Generated by roxygen2: do not edit by hand S3method(resource_compensation_point,Plant) -S3method(validate,Parameters) export("%>%") export(Control) export(Disturbance_Regime) export(FF16_Environment) export(FF16_Individual) -export(FF16_Node) export(FF16_Parameters) -export(FF16_Patch) -export(FF16_SCM) -export(FF16_Species) -export(FF16_StochasticPatch) -export(FF16_StochasticPatchRunner) -export(FF16_StochasticSpecies) export(FF16_Strategy) export(FF16_expand_state) export(FF16_fixed_environment) export(FF16_generate_stand_report) export(FF16_hyperpar) export(FF16_make_environment) -export(FF16_test_environment) export(FF16r_Individual) -export(FF16r_Node) export(FF16r_Parameters) -export(FF16r_Patch) -export(FF16r_SCM) -export(FF16r_Species) -export(FF16r_StochasticPatch) -export(FF16r_StochasticPatchRunner) -export(FF16r_StochasticSpecies) export(FF16r_Strategy) export(FF16r_hyperpar) export(FF16r_make_environment) -export(FF16r_test_environment) export(FF16w_Individual) -export(FF16w_Node) -export(FF16w_Parameters) -export(FF16w_Patch) -export(FF16w_SCM) -export(FF16w_Species) -export(FF16w_StochasticPatch) -export(FF16w_StochasticPatchRunner) -export(FF16w_StochasticSpecies) export(FF16w_Strategy) export(FF16w_fixed_environment) export(FF16w_hyperpar) export(FF16w_make_environment) -export(FF16w_test_environment) export(Individual) -export(Internals) export(Interpolator) export(K93_Environment) export(K93_Individual) -export(K93_Node) export(K93_Parameters) -export(K93_Patch) -export(K93_SCM) -export(K93_Species) -export(K93_StochasticPatch) -export(K93_StochasticPatchRunner) -export(K93_StochasticSpecies) export(K93_Strategy) export(K93_fixed_environment) export(K93_hyperpar) @@ -69,17 +35,9 @@ export(K93_make_environment) export(K93_test_environment) export(No_Disturbance) export(NodeSchedule) -export(OdeControl) export(TF24_Environment) export(TF24_Individual) -export(TF24_Node) export(TF24_Parameters) -export(TF24_Patch) -export(TF24_SCM) -export(TF24_Species) -export(TF24_StochasticPatch) -export(TF24_StochasticPatchRunner) -export(TF24_StochasticSpecies) export(TF24_Strategy) export(TF24_fixed_environment) export(TF24_generate_stand_report) @@ -87,13 +45,7 @@ export(TF24_hyperpar) export(TF24_make_environment) export(TF24_test_environment) export(Weibull_Disturbance_Regime) -export(bounds) -export(bounds_infinite) export(build_schedule) -export(cbind_list) -export(check_bounds) -export(check_point) -export(clamp_domain) export(environment_type) export(expand_parameters) export(fast_control) @@ -101,7 +53,6 @@ export(grow_individual_to_height) export(grow_individual_to_size) export(grow_individual_to_time) export(hyperpar) -export(individual_list) export(integrate_over_size_distribution) export(interpolate_to_heights) export(interpolate_to_times) @@ -114,16 +65,13 @@ export(make_environment) export(make_hyperpar) export(make_patch) export(make_scm_integrate) -export(make_transparent) export(mutant_parameters) -export(nlsolve) export(node_schedule_times_default) export(optimise_individual_rate_at_height_by_trait) export(optimise_individual_rate_at_size_by_trait) export(param_hyperpar) export(plant_log_console) export(plot_size_distribution) -export(rbind_list) export(resource_compensation_point) export(run_plant_benchmarks) export(run_scm) @@ -136,15 +84,11 @@ export(scm_state) export(seq_log) export(seq_log_range) export(seq_range) -export(splinefun_log) -export(splinefun_loglog) -export(strategy) -export(strategy_default) export(strategy_list) export(tidy_individual) export(tidy_patch) export(trait_matrix) -export(validate) +export(util_colour_set_opacity) importFrom(R6,R6Class) importFrom(Rcpp,evalCpp) importFrom(grDevices,col2rgb) diff --git a/R/RcppR6.R b/R/RcppR6.R index e9b91eaf..8a04fb2b 100644 --- a/R/RcppR6.R +++ b/R/RcppR6.R @@ -1,6 +1,6 @@ ## Generated by RcppR6: do not edit by hand ## Version: 0.2.4 -## Hash: 86d2dab10f9081823f16a63c8035a2ae +## Hash: 1e61b714fa073aff744206eaac010b91 ##' @importFrom Rcpp evalCpp ##' @importFrom R6 R6Class @@ -700,7 +700,6 @@ OdeRunner <- function(T) { ##' @title ODE Control parameters ##' @param ...,values Values to initialise the struct with (either as ##' variadic arguments, or as a list, but not both). -##' @export `OdeControl` <- function(..., values=list(...)) { ret <- OdeControl__ctor() if (length(values) > 0L) { @@ -1620,7 +1619,6 @@ IndividualRunner <- function(T, E) { ##' @title Extract Internals from plant object ##' @param s_size ??? ##' @param a_size ??? -##' @export `Internals` <- function(s_size, a_size) { Internals__ctor(s_size, a_size) } diff --git a/R/bounds.R b/R/bounds.R deleted file mode 100644 index 8532a909..00000000 --- a/R/bounds.R +++ /dev/null @@ -1,143 +0,0 @@ -##' Helper function for making bounds -##' @title Trait bounds -##' @param ... Named list, each element of which is a 2-element -##' numeric vector of lower and upper bounds. -##' @export -##' @examples -##' bounds(lma=c(0.01, 10)) -##' bounds(lma=c(0.01, 10), rho=c(1, 1000)) -bounds <- function(...) { - x <- list(...) - if (length(x) == 0) { - stop("Need at least one argument") - } - if (!all(vapply(x, length, integer(1)) == 2)) { - stop("All entries must be length 2") - } - if (is.null(names(x)) || any(names(x) == "")) { - stop("All elements must be named") - } - ret <- rbind_list(x) - colnames(ret) <- c("lower", "upper") - ret -} - -##' @param bounds A set of bounds -##' @param finite Logical indicating if bounds must be finite -##' @rdname bounds -##' @export -check_bounds <- function(bounds, finite=FALSE) { - if (!is.matrix(bounds)) { - stop("bounds must be a matrix") - } - if (ncol(bounds) != 2) { - stop("bounds must have two columns") - } - if (is.null(rownames(bounds))) { - stop("bounds must have rownames") - } - if (finite && any(!is.finite(bounds))) { - stop("bounds must be finite") - } - colnames(bounds) <- c("lower", "upper") - invisible(bounds) -} - -##' @param trait_names Character vector of trait names -##' @rdname bounds -##' @export -bounds_infinite <- function(trait_names) { - n <- length(trait_names) - b <- cbind(lower=rep(-Inf, n), upper=rep(Inf, n)) - rownames(b) <- trait_names - b -} - -##' @export -##' @rdname bounds -##' @param x a point to detect if it lies within bounds -check_point <- function(x, bounds) { - if (is.matrix(x)) { - if (ncol(x) != nrow(bounds)) { - stop("Invalid size x") - } - } else { - if (length(x) != nrow(bounds)) { - stop("Invalid size x") - } - x <- rbind(x, deparse.level=0) - } - if (is.null(names(x))) { - colnames(x) <- rownames(bounds) - } else if (names(x) != rownames(bounds)) { - stop("Incorrect names on x") - } - tx <- t(x) - if (any(tx < bounds[, "lower"] | tx > bounds[, "upper"])) { - stop("Value does not lie within bounds") - } - invisible(x) -} - -##' @importFrom stats uniroot -positive_1d <- function(f, x, dx, lower=-Inf, upper=Inf, tol=1e-3) { - root <- function(b, type) { - x <- b[[type]]$x - fx <- b[[type]]$fx - if (prod(fx[1:2]) < 0) { - ## The suppressWarnings is here to stop the warning - ## -Inf replaced by maximally negative value - ## which we're actually OK with. - suppressWarnings(uniroot(f, x, - f.lower=fx[[1]], f.upper=fx[[2]], - tol=tol)$root) - } else { - if (type == "lower") x[[1]] else x[[2]] - } - } - b <- positive_1d_bracket(f, x, dx, lower, upper) - c(root(b, "lower"), root(b, "upper")) -} - -positive_1d_bracket <- function(f, x, dx, lower, upper, grow=2) { - fx <- f(x) - if (fx < 0) { - stop("Don't yet support doing this with no positive values") - } - - L <- U <- x - fL <- fU <- fx - dL <- dU <- dx - - bracket <- function(x, dx, bound) { - cleanup <- function(x, x_next, fx, fx_next) { - if (dx < 0) { - x <- c(x_next, x) - fx <- c(fx_next, fx) - } else { - x <- c(x, x_next) - fx <- c(fx, fx_next) - } - list(x=x, fx=fx) - } - hit_bounds <- FALSE - repeat { - x_next <- x + dx - if ((dx < 0 && x_next < bound) || (dx > 0 && x_next > bound)) { - x_next <- bound - hit_bounds <- TRUE - } - fx_next <- f(x_next) - if (fx_next < 0 || hit_bounds) { - return(cleanup(x, x_next, fx, fx_next)) - } else { - x <- x_next - fx <- fx_next - dx <- dx * grow - } - } - } - - list(lower=bracket(x, -dx, lower), - upper=bracket(x, dx, upper)) -} diff --git a/R/ff16.R b/R/ff16.R index 78ce3310..6fc7f671 100644 --- a/R/ff16.R +++ b/R/ff16.R @@ -10,55 +10,12 @@ FF16_Individual <- function(s=FF16_Strategy()) { Individual("FF16", "FF16_Env")(s) } -##' @export -##' @rdname FF16 -FF16_Node <- function(s=FF16_Strategy()) { - Node("FF16", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16 -FF16_Species <- function(s=FF16_Strategy()) { - Species("FF16", "FF16_Env")(s) -} - ##' @export ##' @rdname FF16 FF16_Parameters <- function() { Parameters("FF16","FF16_Env")() } -##' @export -##' @rdname FF16 -##' @param p A \code{Parameters} object -FF16_Patch <- function(p) { - Patch("FF16", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16 -FF16_SCM <- function(p) { - SCM("FF16", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16 -FF16_StochasticSpecies <- function(s=FF16_Strategy()) { - StochasticSpecies("FF16", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16 -FF16_StochasticPatch <- function(p) { - StochasticPatch("FF16", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16 -FF16_StochasticPatchRunner <- function(p) { - StochasticPatchRunner("FF16", "FF16_Env")(p) -} - ## Helper to create FF16_environment object. Useful for running individuals ##' @title create FF16_environment object @@ -108,10 +65,9 @@ FF16_fixed_environment <- function(e=1.0, height_max = 150.0) { ##' @param n number of points ##' @param light_env function for light environment in test object ##' @param n_strategies number of strategies for test environment -##' @export ##' @rdname FF16_test_environment ##' @examples -##' environment <- FF16_test_environment(10) +##' environment <- plant:::FF16_test_environment(10) FF16_test_environment <- function(height, n=101, light_env=NULL, n_strategies=1) { diff --git a/R/ff16r.R b/R/ff16r.R index 3e2aa532..c39dbf6a 100644 --- a/R/ff16r.R +++ b/R/ff16r.R @@ -12,55 +12,12 @@ FF16r_Individual <- function(s=FF16r_Strategy()) { Individual("FF16r", "FF16_Env")(s) } -##' @export -##' @rdname FF16r -FF16r_Node <- function(s=FF16r_Strategy()) { - Node("FF16r", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16r -FF16r_Species <- function(s=FF16r_Strategy()) { - Species("FF16r", "FF16_Env")(s) -} - ##' @export ##' @rdname FF16r FF16r_Parameters <- function() { Parameters("FF16r","FF16_Env")() } -##' @export -##' @rdname FF16r -##' @param p A \code{Parameters} object -FF16r_Patch <- function(p) { - Patch("FF16r", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16r -FF16r_SCM <- function(p) { - SCM("FF16r", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16r -FF16r_StochasticSpecies <- function(s=FF16r_Strategy()) { - StochasticSpecies("FF16r", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16r -FF16r_StochasticPatch <- function(p) { - StochasticPatch("FF16r", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16r -FF16r_StochasticPatchRunner <- function(p) { - StochasticPatchRunner("FF16r", "FF16_Env")(p) -} - ## Helper: ##' @export ##' @rdname FF16_Environment @@ -78,10 +35,9 @@ FF16r_make_environment <- function(light_availability_spline_rescale_usually = T ##' @param n number of points ##' @param light_env function for light environment in test object ##' @param n_strategies number of strategies for test environment -##' @export ##' @rdname FF16r_test_environment ##' @examples -##' environment <- FF16r_test_environment(10) +##' environment <- plant:::FF16r_test_environment(10) FF16r_test_environment <- function(height, n=101, light_env=NULL, n_strategies=1) { hh <- seq(0, height, length.out=n) diff --git a/R/ff16w.R b/R/ff16w.R index e3aea1db..f3b4f2ca 100644 --- a/R/ff16w.R +++ b/R/ff16w.R @@ -11,55 +11,11 @@ FF16w_Individual <- function(s=FF16w_Strategy()) { Individual("FF16w", "FF16_Env")(s) } -##' @export -##' @rdname FF16w -FF16w_Node <- function(s=FF16w_Strategy()) { - Node("FF16w", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16w -FF16w_Species <- function(s=FF16w_Strategy()) { - Species("FF16w", "FF16_Env")(s) -} - -##' @export ##' @rdname FF16w FF16w_Parameters <- function() { Parameters("FF16w","FF16_Env")() } -##' @export -##' @rdname FF16w -##' @param p A \code{Parameters} object -FF16w_Patch <- function(p) { - Patch("FF16w", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16w -FF16w_SCM <- function(p) { - SCM("FF16w", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16w -FF16w_StochasticSpecies <- function(s=FF16w_Strategy()) { - StochasticSpecies("FF16w", "FF16_Env")(s) -} - -##' @export -##' @rdname FF16w -FF16w_StochasticPatch <- function(p) { - StochasticPatch("FF16w", "FF16_Env")(p) -} - -##' @export -##' @rdname FF16w -FF16w_StochasticPatchRunner <- function(p) { - StochasticPatchRunner("FF16w", "FF16_Env")(p) -} - ## Helper: ##' @export @@ -131,10 +87,9 @@ FF16w_fixed_environment <- function(e=1.0, height_max = 150.0) { ##' @param n number of points ##' @param light_env function for light environment in test object ##' @param n_strategies number of strategies for test environment -##' @export ##' @rdname FF16w_test_environment ##' @examples -##' environment <- FF16w_test_environment(10) +##' environment <- plant:::FF16w_test_environment(10) FF16w_test_environment <- function(height, n = 101, light_env = NULL, diff --git a/R/individual.R b/R/individual.R index ef0001c4..8176192a 100644 --- a/R/individual.R +++ b/R/individual.R @@ -266,7 +266,7 @@ optimise_individual_rate_at_size_by_trait <- function( set_state_directly = FALSE) { # can't handle situations yet where bounds are outside of positive growth, not working for K93 - bounds <- check_bounds(bounds) +# bounds <- check_bounds(bounds) traits <- rownames(bounds) @@ -281,7 +281,7 @@ optimise_individual_rate_at_size_by_trait <- function( ## Define function to optimise f <- function(x) { # create a strategy object - s <- strategy(ff(trait_matrix(x, rownames(bounds))), parameters = params, hyperpar = hyperpars, birth_rate_list = 1) + s <- strategy_list(ff(trait_matrix(x, rownames(bounds))), parameters = params, hyperpar = hyperpars, birth_rate_list = 1)[[1]] # Create an individual object types <- extract_RcppR6_template_types(params, "Parameters") @@ -367,3 +367,4 @@ solve_max_worker <- function(bounds, f, tol = 1e-3, outcome) { } return(ret) } + diff --git a/R/k93.R b/R/k93.R index 365e106f..84e6eefe 100644 --- a/R/k93.R +++ b/R/k93.R @@ -1,9 +1,5 @@ # Built from R/ff16.R on Fri Jul 24 10:23:19 2020 using the scaffolder, from the strategy: FF16 -## We can probably actually do better than this with an S3 method on -## the actual strategy? That would need to be organised by the -## templating though and that's stretched to the limit. - ##' Create a K93 Individual or Node ##' @title Create a K93 Individual or Node ##' @param s A \code{\link{K93_Strategy}} object @@ -16,60 +12,16 @@ K93_Individual <- function(s=K93_Strategy()) { Individual("K93", "K93_Env")(s) } -##' @export -##' @rdname K93 -K93_Node <- function(s=K93_Strategy()) { - Node("K93", "K93_Env")(s) -} - -##' @export -##' @rdname K93 -K93_Species <- function(s=K93_Strategy()) { - Species("K93", "K93_Env")(s) -} - ##' @export ##' @rdname K93 K93_Parameters <- function() { Parameters("K93","K93_Env")() } -##' @export -##' @rdname K93 -##' @param p A \code{Parameters} object -K93_Patch <- function(p) { - Patch("K93", "K93_Env")(p) -} - -##' @export -##' @rdname K93 -K93_SCM <- function(p) { - SCM("K93", "K93_Env")(p) -} - -##' @export -##' @rdname K93 -K93_StochasticSpecies <- function(s=K93_Strategy()) { - StochasticSpecies("K93", "K93_Env")(s) -} - -##' @export -##' @rdname K93 -K93_StochasticPatch <- function(p) { - StochasticPatch("K93", "K93_Env")(p) -} - -##' @export -##' @rdname K93 -K93_StochasticPatchRunner <- function(p) { - StochasticPatchRunner("K93", "K93_Env")(p) -} - ## Helper to create K93_environment object. Useful for running individuals ##' create K93_environment object ##' @param light_availability_spline_tol -##' ##' @param light_availability_spline_nbase ##' @param light_availability_spline_max_depth ##' @param light_availability_spline_rescale_usually @@ -119,7 +71,7 @@ K93_fixed_environment <- function(e=1.0, height_max = 300.0) { ##' @export ##' @rdname K93_test_environment ##' @examples -##' environment <- K93_test_environment(10) +##' environment <- plant:::K93_test_environment(10) K93_test_environment <- function(height, n=101, light_env=NULL, n_strategies=1) { hh <- seq(0, height, length.out=n) diff --git a/R/scm_support.R b/R/scm_support.R index f0c29d2c..c16d3f26 100644 --- a/R/scm_support.R +++ b/R/scm_support.R @@ -183,6 +183,8 @@ run_scm_error <- function(p, env = make_environment(parameters = p), } } + rbind_list <- function(x) do.call("rbind", as.list(x)) + lai_error <- lapply(lai_error, function(x) rbind_list(pad_matrix(x))) average_fecundity_error <- scm$average_fecundity_error f <- function(m) { diff --git a/R/stochastic.R b/R/stochastic.R index a747ed48..320dedf3 100644 --- a/R/stochastic.R +++ b/R/stochastic.R @@ -3,7 +3,7 @@ ## Generate a vector of arrival times. ## ## This will be slow, but fairly easy to get right. -##' @importFrom stats rexp rpois runif +##' @importFrom stats rexp rpois runif splinefun stochastic_arrival_times <- function(max_time, species, delta_t = 0.1, patch_area = 1) { ret <- numeric(0) t0 <- 0.0 @@ -44,7 +44,7 @@ stochastic_schedule <- function(p) { max_time <- p$max_patch_lifetime n_species <- length(p$strategies) - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$max_time <- max_time for (i in 1:n_species) { diff --git a/R/tf24.R b/R/tf24.R index e66d4d0d..a377a2e0 100644 --- a/R/tf24.R +++ b/R/tf24.R @@ -11,56 +11,12 @@ TF24_Individual <- function(s=TF24_Strategy()) { Individual("TF24", "TF24_Env")(s) } -##' @export -##' @rdname TF24 -TF24_Node <- function(s=TF24_Strategy()) { - Node("TF24", "TF24_Env")(s) -} - -##' @export -##' @rdname TF24 -TF24_Species <- function(s=TF24_Strategy()) { - Species("TF24", "TF24_Env")(s) -} - ##' @export ##' @rdname TF24 TF24_Parameters <- function() { Parameters("TF24","TF24_Env")() } -##' @export -##' @rdname TF24 -##' @param p A \code{Parameters} object -TF24_Patch <- function(p) { - Patch("TF24", "TF24_Env")(p) -} - -##' @export -##' @rdname TF24 -TF24_SCM <- function(p) { - SCM("TF24", "TF24_Env")(p) -} - -##' @export -##' @rdname TF24 -TF24_StochasticSpecies <- function(s=TF24_Strategy()) { - StochasticSpecies("TF24", "TF24_Env")(s) -} - -##' @export -##' @rdname TF24 -TF24_StochasticPatch <- function(p) { - StochasticPatch("TF24", "TF24_Env")(p) -} - -##' @export -##' @rdname TF24 -TF24_StochasticPatchRunner <- function(p) { - StochasticPatchRunner("TF24", "TF24_Env")(p) -} - - ## Helper to create TF24_environment object. Useful for running individuals ##' @title create TF24_environment object ##' @param light_availability_spline_tol @@ -112,7 +68,7 @@ TF24_fixed_environment <- function(e=1.0, height_max = 150.0) { ##' @export ##' @rdname TF24_test_environment ##' @examples -##' environment <- TF24_test_environment(10) +##' environment <- plant:::TF24_test_environment(10) TF24_test_environment <- function(height, n=101, light_env=NULL, n_strategies=1) { diff --git a/R/util.R b/R/util.R index 093faec3..3360332f 100644 --- a/R/util.R +++ b/R/util.R @@ -88,11 +88,11 @@ seq_range <- function(r, length.out) { ##' @title Validate an object ##' @param x Object ##' @param ... Additional arguments to be passed to methods -##' @export +##' @keywords internal validate <- function(x, ...) { UseMethod("validate") } -##' @export + `validate.Parameters` <- function(x, ...) { plant <- parent.env(environment()) ## TODO: This uses an implementation detail of RcppR6 that is not @@ -103,87 +103,7 @@ validate <- function(x, ...) { get(constructor, plant, inherits=FALSE)(x) } -loop <- function(X, FUN, ..., parallel=FALSE) { - if (parallel) { - parallel::mclapply(X, FUN, ..., mc.preschedule=FALSE) - } else { - lapply(X, FUN, ...) - } -} -##' Create a matrix from a list by rbinding all columns together -##' @title Create matrices from lists -##' @param x A list, or something coercable to a list -##' @export -rbind_list <- function(x) { - do.call("rbind", as.list(x)) -} -##' @export -##' @rdname rbind_list -cbind_list <- function(x) { - do.call("cbind", as.list(x)) -} - -##' Spline interpolation in log-x space -##' @title Spline interpolation in log-x space -##' @param x,y Vectors giving coordinates of points to be -##' interpolated. The x points should be naturally on a log scale, -##' and for \code{splinefun_loglog} both x and y should be on a log -##' scale. -##' @param ... Additional parameters passed to -##' \code{\link{splinefun}}. -##' @export -##' @importFrom stats splinefun -##' @author Rich FitzJohn -splinefun_log <- function(x, y, ...) { - f <- splinefun(log(x), y, ...) - function(x) { - f(log(x)) - } -} -##' @export -##' @importFrom stats splinefun -##' @rdname splinefun_log -splinefun_loglog <- function(x, y, ...) { - f <- splinefun(log(x), log(y), ...) - function(x) { - exp(f(log(x))) - } -} - -##' Clamp a function to particular values when outside of a given domain (r) -##' -##' Things like names on input and return vectors are not dealt with -##' very well, and would differ if the function was better -##' constructed. Values falling outwide the domain are not evaluated -##' (which is useful if these would cause crashes, warnings, etc). -##' -##' @title Clamp function to domain -##' @param f A function that takes \code{x} as a first argument. -##' @param r Range of values (vector of length 2) -##' @param value (Single) value to use when out of domain. -##' @return A new function -##' @export -clamp_domain <- function(f, r, value=NA_real_) { - f <- match.fun(f) - if (length(r) != 2L) { - stop("Expected length two range") - } - if (any(is.na(r)) || r[[2]] < r[[1]]) { - stop("Values for range must be finite and not decreasing") - } - if (length(value) != 1L) { - stop("value must be length 1") - } - function(x, ...) { - ret <- rep_len(value, length(x)) - i <- x >= r[[1]] & x <= r[[2]] - if (any(i)) { - ret[i] <- f(x[i]) - } - ret - } -} vlapply <- function(X, FUN, ...) { vapply(X, FUN, logical(1), ...) @@ -205,9 +125,9 @@ vcapply <- function(X, FUN, ...) { ##' @export ##' @importFrom grDevices col2rgb rgb ##' @examples -##' make_transparent("red", seq(0, 1, length.out=6)) -##' make_transparent(c("red", "blue"), .5) -make_transparent <- function(col, opacity=.5) { +##' util_colour_set_opacity("red", seq(0, 1, length.out=6)) +##' util_colour_set_opacity(c("red", "blue"), .5) +util_colour_set_opacity <- function(col, opacity=.5) { alpha <- opacity if (length(alpha) > 1 && any(is.na(alpha))) { n <- max(length(col), length(alpha)) @@ -215,7 +135,7 @@ make_transparent <- function(col, opacity=.5) { col <- rep(col, length.out=n) ok <- !is.na(alpha) ret <- rep(NA, length(col)) - ret[ok] <- make_transparent(col[ok], alpha[ok]) + ret[ok] <- util_colour_set_opacity(col[ok], alpha[ok]) ret } else { tmp <- col2rgb(col)/255 diff --git a/R/util_model.R b/R/util_model.R index cabb3394..32671cd5 100644 --- a/R/util_model.R +++ b/R/util_model.R @@ -45,32 +45,6 @@ strategy_list <- function(x, parameters, hyperpar=param_hyperpar(parameters), bi return(strategies) } -##' @export -##' @rdname strategy_list -strategy_default <- function(parameters, hyperpar=param_hyperpar(parameters)) { - strategy(trait_matrix(1, "a")[, -1, drop=FALSE], parameters, hyperpar) -} - -##' @export -##' @rdname strategy_list -strategy <- function(x, parameters, hyperpar=param_hyperpar(parameters), birth_rate_list) { - if (nrow(x) != 1L) { - stop("Expected a single type") - } - strategy_list(x, parameters, hyperpar, birth_rate_list)[[1]] -} - -##' @rdname strategy_list -##' @export -individual_list <- function(x, parameters, hyperpar=param_hyperpar(parameters), birth_rate_list) { - - if (!inherits(parameters, "Parameters")) { - stop("parameters must be a 'Parameters' object") - } - types <- extract_RcppR6_template_types(parameters, "Parameters") - lapply(strategy_list(x, parameters, hyperpar, birth_rate_list), do.call('Individual', types)) -} - ##' Helper function to create trait matrices suitable for ##' \code{\link{strategy_list}}. ##' @@ -86,7 +60,7 @@ trait_matrix <- function(x, trait_name) { } ##' The functions expand_parameters and mutant_parameters convert trait values into parametr objects for the model. By default, expand_parameters adds an extra strategy to existing. - +##' ##' @title Setup parameters to run resindets or mutants ##' @param trait_matrix A matrix of traits corresponding to the ##' new types to introduce. @@ -107,7 +81,7 @@ expand_parameters <- function(trait_matrix, p, hyperpar=param_hyperpar(p), birth if(nrow(trait_matrix) != length(birth_rate_list)) { stop("Must provide exactly one birth rate input for each species") } - extra <- strategy_list(trait_matrix, p, hyperpar, birth_rate_list) + extra <- plant:::strategy_list(trait_matrix, p, hyperpar, birth_rate_list) n_extra <- length(extra) ret <- p <- validate(p) # Ensure times are set up correctly. @@ -141,8 +115,6 @@ mutant_parameters <- function(..., keep_existing_strategies = FALSE) { expand_parameters(..., keep_existing_strategies = keep_existing_strategies) } - - remove_residents <- function(p) { if (length(p$strategies) > 0L) { p$strategies <- list() diff --git a/R/util_solve.R b/R/util_solve.R deleted file mode 100644 index 2b3375b8..00000000 --- a/R/util_solve.R +++ /dev/null @@ -1,70 +0,0 @@ -##' Thin wrapper around \code{nleqslv} and \code{dfsane} -##' @title Thin wrapper around nleqslv and dfsane -##' @param x Starting point -##' @param fn Function to solve -##' @param tol Tolerance (for \code{nleqslv} this will be both -##' absolute and relative) -##' @param maxit Maximum number of iterations. The number of function -##' evaluations will likely exceed this. -##' @param solver The solver to use. Either "nleqslv" or "dfsane" for now. -##' @export -nlsolve <- function(x, fn, tol=1e-6, maxit=100, solver="nleqslv") { - solver <- match.arg(solver, c("nleqslv", "dfsane")) - - res <- switch(solver, - nleqslv=nlsolve_nleqslv(x, fn, tol, maxit), - dfsane=nlsolve_dfsane(x, fn, tol, maxit), - stop("Unknown solver ", solver)) - - if (!attr(res, "converged")) { - stop(sprintf("Solver has likely failed: code=%d, msg: %s", - attr(res, "code"), attr(res, "message")), - immediate.=TRUE) - } - - res -} - -nlsolve_nleqslv <- function(x, fn, tol=1e-6, maxit=100) { - control <- list(xtol=tol, ftol=tol, maxit=maxit) - sol <- nleqslv::nleqslv(x, fn, global="none", control=control) - code <- sol$termcd - res <- sol$x - attributes(res) <- nlsolve_nleqslv_attr(sol) - res -} - -nlsolve_nleqslv_attr <- function(sol) { - list(y=sol$fvec, # different to dfsane - iter=sol$iter, - feval=sol$nfcnt, # does not include jacobian evals - code=sol$termcd, - message=sol$message, - converged=!(sol$termcd > 2 || sol$termcd < 0), - solver="nleqslv") -} - -nlsolve_dfsane <- function(x, fn, tol=1e-6, maxit=100) { - control <- list(tol=tol, maxit=maxit, trace=FALSE) - ## This works around `is.vector`, which returns FALSE if x has any - ## attribute, which confuses dfsane. - fn_vector <- function(x) as.numeric(fn(x)) - sol <- BB::dfsane(x, fn_vector, control=control, quiet=TRUE) - res <- sol$par - attributes(res) <- nlsolve_dfsane_attr(sol) - res -} - -nlsolve_dfsane_attr <- function(sol) { - list(y=sol$residual, - iter=sol$iter, - feval=sol$feval, - code=sol$convergence, - message=sol$message, - converged=sol$convergence == 0, - solver="dfsane") -} - -failed <- function(x) { - inherits(x, "try-error") -} diff --git a/inst/RcppR6_classes.yml b/inst/RcppR6_classes.yml index 714ece4a..1f4e1750 100644 --- a/inst/RcppR6_classes.yml +++ b/inst/RcppR6_classes.yml @@ -132,7 +132,6 @@ OdeControl: @title ODE Control parameters @param ...,values Values to initialise the struct with (either as variadic arguments, or as a list, but not both). - @export list: - tol_abs: double - tol_rel: double @@ -302,7 +301,6 @@ Internals: @title Extract Internals from plant object @param s_size ??? @param a_size ??? - @export active: state_size: {type: size_t, access: field} aux_size: {type: size_t, access: field} diff --git a/man/FF16.Rd b/man/FF16.Rd index 83d219e3..e61e6215 100644 --- a/man/FF16.Rd +++ b/man/FF16.Rd @@ -1,39 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ff16.R +% Please edit documentation in r/ff16.R \name{FF16_Individual} \alias{FF16_Individual} -\alias{FF16_Node} -\alias{FF16_Species} \alias{FF16_Parameters} -\alias{FF16_Patch} -\alias{FF16_SCM} -\alias{FF16_StochasticSpecies} -\alias{FF16_StochasticPatch} -\alias{FF16_StochasticPatchRunner} \title{Create a FF16 Plant or Node} \usage{ FF16_Individual(s = FF16_Strategy()) -FF16_Node(s = FF16_Strategy()) - -FF16_Species(s = FF16_Strategy()) - FF16_Parameters() - -FF16_Patch(p) - -FF16_SCM(p) - -FF16_StochasticSpecies(s = FF16_Strategy()) - -FF16_StochasticPatch(p) - -FF16_StochasticPatchRunner(p) } \arguments{ \item{s}{A \code{\link{FF16_Strategy}} object} - -\item{p}{A \code{Parameters} object} } \description{ Create a FF16 Plant or Node diff --git a/man/FF16_test_environment.Rd b/man/FF16_test_environment.Rd index 976705f0..5d28420f 100644 --- a/man/FF16_test_environment.Rd +++ b/man/FF16_test_environment.Rd @@ -20,5 +20,5 @@ This makes a pretend light environment over the plant height, slightly concave up, whatever. } \examples{ -environment <- FF16_test_environment(10) +environment <- plant:::FF16_test_environment(10) } diff --git a/man/FF16r.Rd b/man/FF16r.Rd index e1307c67..9758dfd9 100644 --- a/man/FF16r.Rd +++ b/man/FF16r.Rd @@ -1,39 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ff16r.R +% Please edit documentation in r/ff16r.R \name{FF16r_Individual} \alias{FF16r_Individual} -\alias{FF16r_Node} -\alias{FF16r_Species} \alias{FF16r_Parameters} -\alias{FF16r_Patch} -\alias{FF16r_SCM} -\alias{FF16r_StochasticSpecies} -\alias{FF16r_StochasticPatch} -\alias{FF16r_StochasticPatchRunner} \title{Create a FF16r Plant or Node} \usage{ FF16r_Individual(s = FF16r_Strategy()) -FF16r_Node(s = FF16r_Strategy()) - -FF16r_Species(s = FF16r_Strategy()) - FF16r_Parameters() - -FF16r_Patch(p) - -FF16r_SCM(p) - -FF16r_StochasticSpecies(s = FF16r_Strategy()) - -FF16r_StochasticPatch(p) - -FF16r_StochasticPatchRunner(p) } \arguments{ \item{s}{A \code{\link{FF16r_Strategy}} object} - -\item{p}{A \code{Parameters} object} } \description{ Create a FF16r Plant or Node diff --git a/man/FF16r_test_environment.Rd b/man/FF16r_test_environment.Rd index 5e0070de..f96fa79a 100644 --- a/man/FF16r_test_environment.Rd +++ b/man/FF16r_test_environment.Rd @@ -20,5 +20,5 @@ This makes a pretend light environment over the plant height, slightly concave up, whatever. } \examples{ -environment <- FF16r_test_environment(10) +environment <- plant:::FF16r_test_environment(10) } diff --git a/man/FF16w.Rd b/man/FF16w.Rd index c3dd843f..d7bc9269 100644 --- a/man/FF16w.Rd +++ b/man/FF16w.Rd @@ -1,39 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ff16w.R +% Please edit documentation in r/ff16w.R \name{FF16w_Individual} \alias{FF16w_Individual} -\alias{FF16w_Node} -\alias{FF16w_Species} \alias{FF16w_Parameters} -\alias{FF16w_Patch} -\alias{FF16w_SCM} -\alias{FF16w_StochasticSpecies} -\alias{FF16w_StochasticPatch} -\alias{FF16w_StochasticPatchRunner} \title{Create a FF16w Plant or Node} \usage{ FF16w_Individual(s = FF16w_Strategy()) -FF16w_Node(s = FF16w_Strategy()) - -FF16w_Species(s = FF16w_Strategy()) - FF16w_Parameters() - -FF16w_Patch(p) - -FF16w_SCM(p) - -FF16w_StochasticSpecies(s = FF16w_Strategy()) - -FF16w_StochasticPatch(p) - -FF16w_StochasticPatchRunner(p) } \arguments{ \item{s}{A \code{\link{FF16w_Strategy}} object} - -\item{p}{A \code{Parameters} object} } \description{ Create a FF16w Plant or Node diff --git a/man/FF16w_test_environment.Rd b/man/FF16w_test_environment.Rd index 6e4d61b9..bcea3401 100644 --- a/man/FF16w_test_environment.Rd +++ b/man/FF16w_test_environment.Rd @@ -20,5 +20,5 @@ This makes a pretend light environment over the plant height, slightly concave up, whatever. } \examples{ -environment <- FF16w_test_environment(10) +environment <- plant:::FF16w_test_environment(10) } diff --git a/man/K93.Rd b/man/K93.Rd index 17e645a7..b5f9d758 100644 --- a/man/K93.Rd +++ b/man/K93.Rd @@ -1,39 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/k93.R +% Please edit documentation in r/k93.R \name{K93_Individual} \alias{K93_Individual} -\alias{K93_Node} -\alias{K93_Species} \alias{K93_Parameters} -\alias{K93_Patch} -\alias{K93_SCM} -\alias{K93_StochasticSpecies} -\alias{K93_StochasticPatch} -\alias{K93_StochasticPatchRunner} \title{Create a K93 Individual or Node} \usage{ K93_Individual(s = K93_Strategy()) -K93_Node(s = K93_Strategy()) - -K93_Species(s = K93_Strategy()) - K93_Parameters() - -K93_Patch(p) - -K93_SCM(p) - -K93_StochasticSpecies(s = K93_Strategy()) - -K93_StochasticPatch(p) - -K93_StochasticPatchRunner(p) } \arguments{ \item{s}{A \code{\link{K93_Strategy}} object} - -\item{p}{A \code{Parameters} object} } \description{ Create a K93 Individual or Node diff --git a/man/K93_test_environment.Rd b/man/K93_test_environment.Rd index 511fbf8f..ce7fd81b 100644 --- a/man/K93_test_environment.Rd +++ b/man/K93_test_environment.Rd @@ -20,5 +20,5 @@ This makes a pretend light environment over the plant height, slightly concave up, whatever. } \examples{ -environment <- K93_test_environment(10) +environment <- plant:::K93_test_environment(10) } diff --git a/man/bounds.Rd b/man/bounds.Rd deleted file mode 100644 index fd07c836..00000000 --- a/man/bounds.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fitness_support.R -\name{bounds} -\alias{bounds} -\alias{check_bounds} -\alias{bounds_infinite} -\alias{check_point} -\title{Trait bounds} -\usage{ -bounds(...) - -check_bounds(bounds, finite = FALSE) - -bounds_infinite(trait_names) - -check_point(x, bounds) -} -\arguments{ -\item{...}{Named list, each element of which is a 2-element -numeric vector of lower and upper bounds.} - -\item{bounds}{A set of bounds} - -\item{finite}{Logical indicating if bounds must be finite} - -\item{trait_names}{Character vector of trait names} - -\item{x}{a point to detect if it lies within bounds} -} -\description{ -Helper function for making bounds -} -\examples{ -bounds(lma=c(0.01, 10)) -bounds(lma=c(0.01, 10), rho=c(1, 1000)) -} diff --git a/man/clamp_domain.Rd b/man/clamp_domain.Rd deleted file mode 100644 index aeaddc40..00000000 --- a/man/clamp_domain.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util.R -\name{clamp_domain} -\alias{clamp_domain} -\title{Clamp function to domain} -\usage{ -clamp_domain(f, r, value = NA_real_) -} -\arguments{ -\item{f}{A function that takes \code{x} as a first argument.} - -\item{r}{Range of values (vector of length 2)} - -\item{value}{(Single) value to use when out of domain.} -} -\value{ -A new function -} -\description{ -Clamp a function to particular values when outside of a given domain (r) -} -\details{ -Things like names on input and return vectors are not dealt with -very well, and would differ if the function was better -constructed. Values falling outwide the domain are not evaluated -(which is useful if these would cause crashes, warnings, etc). -} diff --git a/man/make_transparent.Rd b/man/make_transparent.Rd deleted file mode 100644 index 75e315ac..00000000 --- a/man/make_transparent.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util.R -\name{make_transparent} -\alias{make_transparent} -\title{Make colours transparent} -\usage{ -make_transparent(col, opacity = 0.5) -} -\arguments{ -\item{col}{Vector of colours} - -\item{opacity}{Vector of opacities} -} -\description{ -Make colours transparent -} -\examples{ -make_transparent("red", seq(0, 1, length.out=6)) -make_transparent(c("red", "blue"), .5) -} diff --git a/man/nlsolve.Rd b/man/nlsolve.Rd deleted file mode 100644 index 0bc1bdce..00000000 --- a/man/nlsolve.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util_solve.R -\name{nlsolve} -\alias{nlsolve} -\title{Thin wrapper around nleqslv and dfsane} -\usage{ -nlsolve(x, fn, tol = 1e-06, maxit = 100, solver = "nleqslv") -} -\arguments{ -\item{x}{Starting point} - -\item{fn}{Function to solve} - -\item{tol}{Tolerance (for \code{nleqslv} this will be both -absolute and relative)} - -\item{maxit}{Maximum number of iterations. The number of function -evaluations will likely exceed this.} - -\item{solver}{The solver to use. Either "nleqslv" or "dfsane" for now.} -} -\description{ -Thin wrapper around \code{nleqslv} and \code{dfsane} -} diff --git a/man/rbind_list.Rd b/man/rbind_list.Rd deleted file mode 100644 index fcfb25ab..00000000 --- a/man/rbind_list.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util.R -\name{rbind_list} -\alias{rbind_list} -\alias{cbind_list} -\title{Create matrices from lists} -\usage{ -rbind_list(x) - -cbind_list(x) -} -\arguments{ -\item{x}{A list, or something coercable to a list} -} -\description{ -Create a matrix from a list by rbinding all columns together -} diff --git a/man/splinefun_log.Rd b/man/splinefun_log.Rd deleted file mode 100644 index 550e8783..00000000 --- a/man/splinefun_log.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util.R -\name{splinefun_log} -\alias{splinefun_log} -\alias{splinefun_loglog} -\title{Spline interpolation in log-x space} -\usage{ -splinefun_log(x, y, ...) - -splinefun_loglog(x, y, ...) -} -\arguments{ -\item{x, y}{Vectors giving coordinates of points to be -interpolated. The x points should be naturally on a log scale, -and for \code{splinefun_loglog} both x and y should be on a log -scale.} - -\item{...}{Additional parameters passed to -\code{\link{splinefun}}.} -} -\description{ -Spline interpolation in log-x space -} -\author{ -Rich FitzJohn -} diff --git a/man/strategy_list.Rd b/man/strategy_list.Rd index 3fe62eec..067bf6e3 100644 --- a/man/strategy_list.Rd +++ b/man/strategy_list.Rd @@ -1,10 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/util_model.R +% Please edit documentation in r/util_model.R \name{strategy_list} \alias{strategy_list} -\alias{strategy_default} -\alias{strategy} -\alias{individual_list} \title{Create a list of Strategies} \usage{ strategy_list( @@ -13,17 +10,6 @@ strategy_list( hyperpar = param_hyperpar(parameters), birth_rate_list ) - -strategy_default(parameters, hyperpar = param_hyperpar(parameters)) - -strategy(x, parameters, hyperpar = param_hyperpar(parameters), birth_rate_list) - -individual_list( - x, - parameters, - hyperpar = param_hyperpar(parameters), - birth_rate_list -) } \arguments{ \item{x}{Values for the trait. This must be a \emph{matrix}, with diff --git a/man/util_colour_set_opacity.Rd b/man/util_colour_set_opacity.Rd new file mode 100644 index 00000000..f906d977 --- /dev/null +++ b/man/util_colour_set_opacity.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in r/util.R +\name{util_colour_set_opacity} +\alias{util_colour_set_opacity} +\title{Make colours transparent} +\usage{ +util_colour_set_opacity(col, opacity = 0.5) +} +\arguments{ +\item{col}{Vector of colours} + +\item{opacity}{Vector of opacities} +} +\description{ +Make colours transparent +} +\examples{ +util_colour_set_opacity("red", seq(0, 1, length.out=6)) +util_colour_set_opacity(c("red", "blue"), .5) +} diff --git a/man/validate.Rd b/man/validate.Rd index 8ee8fa05..6885e9ae 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -15,3 +15,4 @@ validate(x, ...) Validate an object. Currently only \code{Parameters} objects are validated. } +\keyword{internal} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index cf3cc6f6..823acb60 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -154,28 +154,18 @@ reference: - title: Development & testing contents: - run_plant_benchmarks - - validate - title: Helpers desc: Small function used in vignettes. (Remove from package or make private?) contents: - - bounds - - clamp_domain - seq_log - - rbind_list - - make_transparent - - splinefun_log + - util_colour_set_opacity - title: Numerical methods desc: You're unlikely to run these unless you're diving deep into the code. (Do these need to be exposed? Should they be private?) contents: - environment_type - - Internals - Interpolator - - OdeControl - - NodeSchedule - - QK - - nlsolve - title: Review if still needed contents: @@ -183,3 +173,12 @@ reference: - node_schedule_times_default - make_patch +- title: Internal functions (for developers/advanced users only) + contents: + - NodeSchedule + - OdeControl + - QK + - validate + - Internals + + diff --git a/tests/testthat/helper-plant.R b/tests/testthat/helper-plant.R index b8c827da..54be8e0a 100644 --- a/tests/testthat/helper-plant.R +++ b/tests/testthat/helper-plant.R @@ -67,11 +67,11 @@ get_list_of_hyperpar_functions <- function() { test_environment <- function(type, ...) { switch(type, - FF16=FF16_test_environment(...), - TF24=TF24_test_environment(...), - FF16w=FF16w_test_environment(...), - FF16r=FF16_test_environment(...), - K93=K93_test_environment(...), + FF16=plant:::FF16_test_environment(...), + TF24=plant:::TF24_test_environment(...), + FF16w=plant:::FF16w_test_environment(...), + FF16r=plant:::FF16_test_environment(...), + K93=plant:::K93_test_environment(...), stop("Unknown type ", type)) } diff --git a/tests/testthat/test-birth-rate-splines.r b/tests/testthat/test-birth-rate-splines.r index 5b65fc6e..dcd6e2a4 100644 --- a/tests/testthat/test-birth-rate-splines.r +++ b/tests/testthat/test-birth-rate-splines.r @@ -45,7 +45,7 @@ test_that("Can set birth rate splines correctly", { # strategy 1 (variable) - s1 <- FF16_Species(p1$strategies[[1]]) + s1 <- Species("FF16", "FF16_Env")(p1$strategies[[1]]) k = c(1, 2, 3) expect_equal(s1$extrinsic_drivers$evaluate("birth_rate", 200), 1 + sin(200)) @@ -53,7 +53,7 @@ test_that("Can set birth rate splines correctly", { expect_equal(s1$extrinsic_drivers$get_names(), c("birth_rate")) # strategy 2 (constant) - s2 <- FF16_Species(p1$strategies[[2]]) + s2 <- Species("FF16", "FF16_Env")(p1$strategies[[2]]) expect_equal(s2$extrinsic_drivers$evaluate("birth_rate", 200), 2) expect_equal(s2$extrinsic_drivers$evaluate_range("birth_rate", k), c(2, 2, 2)) diff --git a/tests/testthat/test-individual-utils.R b/tests/testthat/test-individual-utils.R index f5f73089..8f116a5f 100644 --- a/tests/testthat/test-individual-utils.R +++ b/tests/testthat/test-individual-utils.R @@ -57,22 +57,9 @@ test_that("strategy_list", { for (x in c("FF16", "FF16r")) { e <- environment_types[[x]] p <- Parameters(x, e)() - s <- strategy_list(trait_matrix(1, "lma"), p, make_hyperpar(x)(), 1.0) + s <- plant:::strategy_list(trait_matrix(1, "lma"), p, make_hyperpar(x)(), 1.0) expect_equal(length(s), 1) expect_is(s, "list") expect_is(s[[1]], sprintf("%s_Strategy", x)) } }) - -test_that("individual_list", { - for (x in names(strategy_types)) { - e <- environment_types[[x]] - p <- Parameters(x, e)() - - obj <- individual_list(trait_matrix(1, "lma"), p, make_hyperpar(x)(), 1.0) - expect_equal(length(obj), 1) - expect_is(obj, "list") - expect_is(obj[[1]], "Individual") - expect_is(obj[[1]], sprintf("Individual<%s,%s>", x, e)) - } -}) diff --git a/tests/testthat/test-individual.R b/tests/testthat/test-individual.R index 82810cc2..7de6c09f 100644 --- a/tests/testthat/test-individual.R +++ b/tests/testthat/test-individual.R @@ -3,6 +3,13 @@ strategy_types <- get_list_of_strategy_types() environment_types <- get_list_of_environment_types() +bounds <- function(...) { + x <- list(...) + ret <- do.call("rbind", as.list(x)) + colnames(ret) <- c("lower", "upper") + ret +} + for (x in names(strategy_types)) { context(sprintf("Individual-%s",x)) @@ -139,7 +146,7 @@ for (x in names(strategy_types)) { test_that("Maximise individual rate", { if(x %in% c("FF16", "FF16r")) { - + #set bounds bounds = bounds(lma=c(0.01, 3)) diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R index 9b07f415..a9a73d22 100644 --- a/tests/testthat/test-internals.R +++ b/tests/testthat/test-internals.R @@ -3,7 +3,7 @@ context("Internals") test_that("internals getters and setters", { n = 3 a_n = 2 - ints = Internals(s_size = n, a_size = 2) + ints = plant:::Internals(s_size = n, a_size = 2) for ( i in 0:(n-1)) { ints$set_state(i,10) expect_equal(ints$state(i), 10) @@ -17,18 +17,18 @@ test_that("internals getters and setters", { }) test_that("Creation and defaults", { - internals = Internals(s_size = 0, a_size = 0) + internals = plant:::Internals(s_size = 0, a_size = 0) expect_is(internals, "Internals") expect_equal(internals$state_size, 0) expect_equal(internals$aux_size, 0) n = 10 - ints = Internals(s_size = n, a_size = n) + ints = plant:::Internals(s_size = n, a_size = n) expect_equal(all(is.na(ints$rates)),TRUE) expect_identical(ints$states, rep(0.0, n)) }) test_that("Resize", { - internals = Internals(s_size = 0, a_size = 0) + internals = plant:::Internals(s_size = 0, a_size = 0) expect_equal(internals$state_size, 0) expect_equal(internals$aux_size, 0) internals$resize(new_size = 20, new_aux_size = 10) diff --git a/tests/testthat/test-node-schedule.R b/tests/testthat/test-node-schedule.R index a0283963..443a4e9f 100644 --- a/tests/testthat/test-node-schedule.R +++ b/tests/testthat/test-node-schedule.R @@ -13,7 +13,7 @@ drain_schedule <- function(sched) { if (!all(sapply(cmp, length) == 5)) { stop("Expected exactly five elements for each schedule") } - cmp <- rbind_list(cmp) + cmp <- do.call("rbind", as.list(cmp)) } cmp } @@ -37,7 +37,7 @@ test_that("NodeScheduleEvent", { test_that("Empty NodeSchedule", { n_species <- 2 - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) expect_is(sched, "NodeSchedule") expect_equal(sched$size, 0) @@ -52,7 +52,7 @@ test_that("Empty NodeSchedule", { test_that("Corner cases", { n_species <- 2 - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) set.seed(1) t1 <- c(0.0, runif(10)) @@ -74,7 +74,7 @@ test_that("Set times (one species)", { t2 <- sort(c(0.0, runif(12))) n_species <- 2 - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$set_times(t1, 1L) expect_equal(sched$size, length(t1)) @@ -104,7 +104,7 @@ test_that("Set times (two species)", { t2 <- sort(c(0.0, runif(12))) n_species <- 2 - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$set_times(t1, 1L) sched$set_times(t2, 2L) @@ -142,7 +142,7 @@ test_that("Resetting times replaces them", { t2 <- sort(c(0.0, runif(12))) n_species <- 2 - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$set_times(t1, 1L) sched$set_times(t2, 2L) @@ -158,7 +158,7 @@ test_that("Setting max time behaves sensibly", { t1 <- sort(c(0.0, runif(10))) t2 <- sort(c(0.0, runif(12))) - sched <- NodeSchedule(2) + sched <- plant:::NodeSchedule(2) sched$set_times(t1, 1) last_event <- function(x) { @@ -193,7 +193,7 @@ test_that("Setting max time behaves sensibly", { test_that("Bulk get/set of times works", { n <- 3 - sched <- NodeSchedule(n) + sched <- plant:::NodeSchedule(n) set.seed(1) t_new <- lapply(seq_len(n), function(...) sort(runif(rpois(1, 10)))) @@ -215,7 +215,7 @@ test_that("ode_times", { n_species <- 2 max_t <- max(c(t1, t2)) + mean(diff(sort(c(t1, t2)))) - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$set_times(t1, 1L) sched$set_times(t2, 2L) sched$max_time <- max_t @@ -254,7 +254,7 @@ test_that("ode_times", { ## New schedule because setting and resetting may have changed node ## order. - sched <- NodeSchedule(n_species) + sched <- plant:::NodeSchedule(n_species) sched$set_times(t1, 1L) sched$set_times(t2, 2L) sched$max_time <- max_t @@ -286,7 +286,7 @@ test_that("ode_times", { }) test_that("Can expand NodeSchedule", { - sched <- NodeSchedule(1) + sched <- plant:::NodeSchedule(1) max_t <- 10 times1 <- sort(runif(10)) sched$max_time <- max_t diff --git a/tests/testthat/test-ode-control.R b/tests/testthat/test-ode-control.R index bcbda59c..40f9f1a2 100644 --- a/tests/testthat/test-ode-control.R +++ b/tests/testthat/test-ode-control.R @@ -11,7 +11,7 @@ test_that("Defaults", { step_size_initial=1e-6) keys <- sort(names(expected)) - ctrl <- OdeControl() + ctrl <- plant:::OdeControl() expect_is(ctrl, "OdeControl") expect_identical(sort(names(ctrl)), keys) diff --git a/tests/testthat/test-ode-individual-runner.R b/tests/testthat/test-ode-individual-runner.R index cf90b9ea..3ed6f001 100644 --- a/tests/testthat/test-ode-individual-runner.R +++ b/tests/testthat/test-ode-individual-runner.R @@ -233,7 +233,7 @@ test_that("Sensible behaviour on integration failure", { c("eta","lma","rho","theta","a_l1","a_l2","a_r1","a_b1","r_r","k_b","k_r","omega","B_kl1","B_kl2","B_ks1","narea","B_lf1","B_lf5","B_lf4","B_rs1","B_rb1","hmat","c_r1") ) - s <- strategy(traits, scm_base_parameters("FF16"), hyperpar, 1.0) + s <- strategy_list(traits, scm_base_parameters("FF16"), hyperpar, 1.0)[[1]] pl <- FF16_Individual(s) env <- fixed_environment("FF16", 1) diff --git a/tests/testthat/test-parameters.R b/tests/testthat/test-parameters.R index 8d39da18..689a2aef 100644 --- a/tests/testthat/test-parameters.R +++ b/tests/testthat/test-parameters.R @@ -101,7 +101,7 @@ test_that("Validate", { for (x in names(strategy_types)) { e <- environment_types[[x]] p <- Parameters(x, e)() - expect_equal(validate(p), p) + expect_equal(plant:::validate(p), p) } }) @@ -122,13 +122,13 @@ test_that("Patch runtime", { ## This is going to force us back through the validator p$max_patch_lifetime <- 35.10667 - p2 <- validate(p) + p2 <- plant:::validate(p) expect_lt(last(p2$node_schedule_times_default), p2$max_patch_lifetime) expect_equal(p2$node_schedule_times, list(p2$node_schedule_times_default)) ## We will blow away any data that is stored in p$node_schedule* p$node_schedule_times_default <- 1:10 p$node_schedule_time <- list(1:11) - expect_equal(validate(p), p2) + expect_equal(plant:::validate(p), p2) } }) diff --git a/tests/testthat/test-qag.R b/tests/testthat/test-qag.R index 6c204f68..c2a2bb66 100644 --- a/tests/testthat/test-qag.R +++ b/tests/testthat/test-qag.R @@ -1,6 +1,9 @@ context("QAG") ## First where no subdivisions are required: +cbind_list <- function(x) { + do.call("cbind", as.list(x)) +} test_that("Integration agrees with R on simple problem", { f <- sin diff --git a/tests/testthat/test-scm.R b/tests/testthat/test-scm.R index 5444fcbc..a05d38a2 100644 --- a/tests/testthat/test-scm.R +++ b/tests/testthat/test-scm.R @@ -40,7 +40,7 @@ test_that("Run SCM", { ## If the schedule is for the wrong number of species, it should cause ## an error... - sched2 <- NodeSchedule(sched$n_species + 1) + sched2 <- plant:::NodeSchedule(sched$n_species + 1) expect_error(scm$node_schedule <- sched2, "Incorrect length input; expected 1, received 2") ## Build a schedule for 14 introductions from t=0 to t=5 diff --git a/tests/testthat/test-strategy-ff16.R b/tests/testthat/test-strategy-ff16.R index fce9a48a..42569a4b 100644 --- a/tests/testthat/test-strategy-ff16.R +++ b/tests/testthat/test-strategy-ff16.R @@ -168,9 +168,9 @@ test_that("narea calculation", { x <- c(1.38, 3.07, 2.94) p0 <- FF16_Parameters() m <- trait_matrix(x, "hmat") - expect_silent(sl <- strategy_list(m, p0, FF16_hyperpar, birth_rate_list=1.0)) + expect_silent(sl <- plant:::strategy_list(m, p0, FF16_hyperpar, birth_rate_list=1.0)) - cmp <- lapply(x, function(xi) strategy(trait_matrix(xi, "hmat"), p0, FF16_hyperpar, birth_rate_list=1.0)) + cmp <- lapply(x, function(xi) strategy_list(trait_matrix(xi, "hmat"), p0, FF16_hyperpar, birth_rate_list=1.0)[[1]]) expect_equal(sl, cmp) }) diff --git a/tests/testthat/test-strategy-tf24.R b/tests/testthat/test-strategy-tf24.R index c5133d0f..ff1d8686 100644 --- a/tests/testthat/test-strategy-tf24.R +++ b/tests/testthat/test-strategy-tf24.R @@ -169,9 +169,9 @@ test_that("narea calculation", { x <- c(1.38, 3.07, 2.94) p0 <- TF24_Parameters() m <- trait_matrix(x, "hmat") - expect_silent(sl <- strategy_list(m, p0, TF24_hyperpar, birth_rate_list=1.0)) + expect_silent(sl <- plant:::strategy_list(m, p0, TF24_hyperpar, birth_rate_list=1.0)) - cmp <- lapply(x, function(xi) strategy(trait_matrix(xi, "hmat"), p0, TF24_hyperpar, birth_rate_list=1.0)) + cmp <- lapply(x, function(xi) strategy_list(trait_matrix(xi, "hmat"), p0, TF24_hyperpar, birth_rate_list=1.0)[[1]]) expect_equal(sl, cmp) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R deleted file mode 100644 index a8e20259..00000000 --- a/tests/testthat/test-utils.R +++ /dev/null @@ -1,15 +0,0 @@ -context("utils") - -test_that("clamp_range", { - f <- clamp_domain(identity, c(0, 1), Inf) - expect_identical(f(0), 0) - expect_identical(f(0L), 0.0) - expect_identical(f(-1), Inf) - expect_identical(f(1.1), Inf) - - f <- clamp_domain(identity, c(-Inf, 0), NA) - expect_equal(f(-100), -100) - - expect_error(clamp_domain(identity, 1), "Expected length two range") - expect_error(clamp_domain(identity, c(0, 1), c(1, 1, 1)), "value must be length 1") -}) diff --git a/vignettes/emergent.Rmd b/vignettes/emergent.Rmd index fbcfeb97..cf83b710 100644 --- a/vignettes/emergent.Rmd +++ b/vignettes/emergent.Rmd @@ -58,7 +58,7 @@ to be the state of the system at a given time): ```{r} density <- exp(log_density) matplot(height, density, type="l", lty=1, - col=make_transparent("black", 0.15), + col=util_colour_set_opacity("black", 0.15), xlab="Height (m)", ylab="Density (1 / m / m2)", las=1, log="y") ``` @@ -75,7 +75,7 @@ highlighted. ```{r} xlim <- c(0, max(height, na.rm=TRUE) * 1.05) matplot(height, density, type="l", lty=1, - col=make_transparent("black", 0.15), + col=util_colour_set_opacity("black", 0.15), xlab="Height (m)", ylab="Density (1 / m / m2)", las=1, log="y", xlim=xlim) matlines(height[, i], density[, i], col=cols, lty=1, type="l") @@ -156,6 +156,55 @@ We'll use a spline interpolation, on log-log-scaled data, clamped so that for x values outside the observed range are set to zero. ```{r} +##' Spline interpolation in log-x space +##' @title Spline interpolation in log-x space +##' @param x,y Vectors giving coordinates of points to be +##' interpolated. The x points should be naturally on a log scale, +##' and for \code{splinefun_loglog} both x and y should be on a log +##' scale. +##' @param ... Additional parameters passed to +##' @rdname splinefun_log +splinefun_loglog <- function(x, y, ...) { + f <- splinefun(log(x), log(y), ...) + function(x) { + exp(f(log(x))) + } +} + +##' Clamp a function to particular values when outside of a given domain (r) +##' +##' Things like names on input and return vectors are not dealt with +##' very well, and would differ if the function was better +##' constructed. Values falling outwide the domain are not evaluated +##' (which is useful if these would cause crashes, warnings, etc). +##' +##' @title Clamp function to domain +##' @param f A function that takes \code{x} as a first argument. +##' @param r Range of values (vector of length 2) +##' @param value (Single) value to use when out of domain. +##' @return A new function +##' @export +clamp_domain <- function(f, r, value = NA_real_) { + f <- match.fun(f) + if (length(r) != 2L) { + stop("Expected length two range") + } + if (any(is.na(r)) || r[[2]] < r[[1]]) { + stop("Values for range must be finite and not decreasing") + } + if (length(value) != 1L) { + stop("value must be length 1") + } + function(x, ...) { + ret <- rep_len(value, length(x)) + i <- x >= r[[1]] & x <= r[[2]] + if (any(i)) { + ret[i] <- f(x[i]) + } + ret + } +} + f <- function(height, density, hout) { r <- range(height, na.rm=TRUE) clamp_domain(splinefun_loglog(height, density), r, 0)(hout) @@ -185,7 +234,7 @@ Add this average to the plot (red line): ```{r} xlim <- c(0, max(height, na.rm=TRUE) * 1.05) matplot(height, density, type="l", lty=1, - col=make_transparent("black", 0.15), + col=util_colour_set_opacity("black", 0.15), xlab="Height (m)", ylab="Density (1 / m / m2)", las=1, log="y", xlim=xlim) matlines(height[, i], density[, i], col=cols, lty=1, type="l") diff --git a/vignettes/extrinsic_drivers.Rmd b/vignettes/extrinsic_drivers.Rmd index ce3f0689..8ebf94d5 100644 --- a/vignettes/extrinsic_drivers.Rmd +++ b/vignettes/extrinsic_drivers.Rmd @@ -77,13 +77,7 @@ p1 <- expand_parameters(lmas, p0, FF16_hyperpar, ctrl <- scm_base_control() out <- run_scm(p1, env, ctrl) ``` -Evaluating the birth rate can either be done at the individual species level: - -```{r} -s1 <- FF16w_Species(p1$strategies[[1]]) -s1$extrinsic_drivers$evaluate("birth_rate", 7) -``` -... or after the SCM has run: +Evaluating the birth rate can either be done after the SCM has run: ```{r} out <- run_scm(p1, env, ctrl) diff --git a/vignettes/individuals.Rmd b/vignettes/individuals.Rmd index 7ff3f4a9..1f202dc3 100644 --- a/vignettes/individuals.Rmd +++ b/vignettes/individuals.Rmd @@ -231,21 +231,18 @@ First, we load the FF16 strategy pre-populated with a set of default parameters params <- scm_base_parameters("FF16") ``` -Then we can use the `params` object to set a low LMA ("fast growth") species: +Then we can use the `params` object to set a low LMA ("fast growth") and a high LMA ("low growth") species: ```{r } -s1 <- strategy(trait_matrix(0.0825, "lma"), params, birth_rate_list = 1) -``` - -and a high LMA ("low growth") species: -```{r } -s2 <- strategy(trait_matrix(0.2625, "lma"), params, birth_rate_list = 1) +s <- trait_matrix(c(0.0825, 0.2625), "lma") %>% + strategy_list(params, birth_rate_list = 1) +s1 <- s[[1]] +s2 <- s[[2]] ``` In the FF16 model, LMA is related to leaf turnover (`k_l`) and the ratio of dark respiration to leaf mass (`r_l`): ```{r } -lapply(list(s1, s2), `[`, c("lma", "k_l", "r_l")) - +lapply(s, `[`, c("lma", "k_l", "r_l")) ``` We use these specific strategies to create Individuals: diff --git a/vignettes/models/strategy_K93.Rmd b/vignettes/models/strategy_K93.Rmd index e3a64565..4448fd3e 100644 --- a/vignettes/models/strategy_K93.Rmd +++ b/vignettes/models/strategy_K93.Rmd @@ -73,7 +73,7 @@ p1$seed_rain <- 20 data1 <- run_scm_collect(p1) matplot(data1$time, data1$species[[1]]["height", , ], - lty=1, col=make_transparent("black", 0.25), type="l", + lty=1, col=util_colour_set_opacity("black", 0.25), type="l", las=1, xlab="Time (years)", ylab="Height (m)") ``` diff --git a/vignettes/parameters.Rmd b/vignettes/parameters.Rmd index 6586acc3..98acd248 100644 --- a/vignettes/parameters.Rmd +++ b/vignettes/parameters.Rmd @@ -120,7 +120,7 @@ This is the Strategy object that all others will be built from by difference. Running ```{r} -s <- strategy(trait_matrix(0.1, "lma"), p, birth_rate_list = 1) +s <- strategy_list(trait_matrix(0.1, "lma"), p, birth_rate_list = 1)[[1]] ``` will create a strategy `s` where lma is set but also all the @@ -146,15 +146,6 @@ sapply(ss, function(x) x$a_p1) sapply(ss, function(x) x$r_l) ``` -There's a convenience function `plant_list` that returns a set of -*plants* based on a vector of traits: - -```{r} -pp <- individual_list(lma, p, birth_rate_list = rep(1, 5)) - -sapply(pp, function(p) p$compute_competition(0)) -``` - In addition to the physiological parameters there are large number of "control" parameters that affect the behaviour of the various numerical algorithms used (note that in contrast to the diff --git a/vignettes/patch.Rmd b/vignettes/patch.Rmd index 634bae94..4b20fb59 100644 --- a/vignettes/patch.Rmd +++ b/vignettes/patch.Rmd @@ -101,7 +101,7 @@ In the `FF16` strategy, Individuals increase in height with respect to time, but We can plot the trajectories of nodes developing within a patch over time: ```{r} -matplot(t, h, lty=1, col=make_transparent("black", 0.25), type="l", +matplot(t, h, lty=1, col=util_colour_set_opacity("black", 0.25), type="l", las=1, xlab="Time (years)", ylab="Height (m)") ``` @@ -187,22 +187,22 @@ h2 <- result_2sp$species[[2]]["height", , ] cols <- c("#e34a33", "#045a8d") # Species 1 - red -matplot(t2, h1, lty=1, col=make_transparent(cols[[1]], .25), type="l", +matplot(t2, h1, lty=1, col=util_colour_set_opacity(cols[[1]], .25), type="l", las=1, xlab="Time (years)", ylab="Height (m)") # Species 2 - blue -matlines(t2, h2, lty=1, col=make_transparent(cols[[2]], .25)) +matlines(t2, h2, lty=1, col=util_colour_set_opacity(cols[[2]], .25)) ``` Alternatively we can compare the growth of the low LMA species (red) in a patch by itself or with another species: ```{r} # Monoculture patch (black) -matplot(t, h, lty=1, col=make_transparent("black", .25), type="l", +matplot(t, h, lty=1, col=util_colour_set_opacity("black", .25), type="l", las=1, xlab="Time (years)", ylab="Height (m)") # Two species patch (red) -matlines(t2, h1, lty=1, col=make_transparent(cols[[1]], .25)) +matlines(t2, h1, lty=1, col=util_colour_set_opacity(cols[[1]], .25)) ``` This shows that the additional species does not significantly affect the growth of the *initial* wave of nodes (because the second species is growing more slowly and is shorter than the first species). However, once canopy closure has occurred (around year 5), subsequent waves of arriving nodes are competitively suppressed, slowed or eliminated. @@ -227,8 +227,8 @@ rd2 <- rel(d2, -4) # the first part of the line segment: n <- length(t2) x <- matrix(rep(t2, ncol(h1)), nrow(h1)) -col1 <- matrix(make_transparent(cols[[1]], rd1), nrow(d1)) -col2 <- matrix(make_transparent(cols[[2]], rd2), nrow(d2)) +col1 <- matrix(util_colour_set_opacity(cols[[1]], rd1), nrow(d1)) +col2 <- matrix(util_colour_set_opacity(cols[[2]], rd2), nrow(d2)) plot(NA, xlim=range(t2), ylim=range(h1, na.rm=TRUE), las=1, xlab="Time (years)", ylab="Node height (m)") segments(x[-1, ], h2[-1, ], x[-n, ], h2[-n, ], col=col2[-n, ], lend="butt") diff --git a/vignettes/strategy_new.Rmd b/vignettes/strategy_new.Rmd index ab279151..6a6881d8 100644 --- a/vignettes/strategy_new.Rmd +++ b/vignettes/strategy_new.Rmd @@ -492,7 +492,7 @@ p1$seed_rain <- 20 data1 <- run_scm_collect(p1) matplot(data1$time, data1$species[[1]]["height", , ], - lty=1, col=make_transparent("black", 0.25), type="l", + lty=1, col=util_colour_set_opacity("black", 0.25), type="l", las=1, xlab="Time (years)", ylab="Height (m)") ```