From 5adde120179d6f1a87e8eb2ee61460b72f006a1b Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sun, 11 Jul 2021 20:23:36 +0100 Subject: [PATCH] First stab at a `validSim()` function that will be useful when simulations produce non-finite values. See #20 --- DESCRIPTION | 1 + NAMESPACE | 1 + R/validSim.R | 48 +++++++++ _pkgdown.yml | 3 + docs/reference/index.html | 40 ++++--- docs/reference/validSim.html | 184 +++++++++++++++++++++++++++++++++ man/validSim.Rd | 19 ++++ tests/testthat/test-validSim.R | 13 +++ 8 files changed, 296 insertions(+), 13 deletions(-) create mode 100644 R/validSim.R create mode 100644 docs/reference/validSim.html create mode 100644 man/validSim.Rd create mode 100644 tests/testthat/test-validSim.R diff --git a/DESCRIPTION b/DESCRIPTION index adce67c7..c448a145 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,7 @@ Collate: tuneParams_helpers.R getYieldVsFcurve.R setBevertonHolt.R + validSim.R Encoding: UTF-8 RoxygenNote: 7.1.1 Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index 5c31e521..0bfc6dbd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ export(tuneParams_add_to_logs) export(tuneParams_run_steady) export(tuneParams_update_species) export(updateInitialValues) +export(validSim) import(assertthat) import(dplyr) import(ggplot2) diff --git a/R/validSim.R b/R/validSim.R new file mode 100644 index 00000000..bba35f4b --- /dev/null +++ b/R/validSim.R @@ -0,0 +1,48 @@ +#' Returns a valid simulation by removing non-finite results +#' +#' Checks whether any abundances are non-finite and if any are found, a warning +#' is issued and the simulation is truncated at the last time step where all +#' results are finite. +#' +#' @param sim A MizerSim object +#' @return A MizerSim object with possibly fewer time steps +#' @export +validSim <- function(sim) { + assert_that(is(sim, "MizerSim")) + if (!all(is.finite(sim@n))) { + inf_idx <- which(!is.finite(sim@n), arr.ind = TRUE) + max_t_idx <- min(inf_idx[, 1]) - 1 + max_t <- as.numeric(dimnames(sim@n)$time[max_t_idx]) + warning("The simulation failed to work beyond time = ", max_t) + # we can't use drop = FALSE because we do want to drop time dimension. + n <- sim@n[max_t_idx, , ] + dim(n) <- dim(sim@n)[2:3] + rates <- getRates(sim@params, + n = n, + n_pp = sim@n_pp[max_t_idx, ], + n_other = sim@n_pp[max_t_idx, ], + effort = sim@effort[max_t_idx, ], + t = max_t) + inf_rates <- sapply(rates, function(x) any(!is.finite(x))) + if (any(inf_rates)) { + warning("The following rates failed to be finite: ", + paste(names(rates)[inf_rates], collapse = ", "), ".") + } + sim <- truncateSim(sim, end_time = max_t) + } + sim +} + +truncateSim <- function(sim, end_time) { + assert_that(is(sim, "MizerSim")) + times <- dimnames(sim@n)$time + if (!(end_time %in% times)) { + stop("end_time = ", end_time, " is not a valid time contained in the simulation.") + } + t_idx <- match(end_time, times) + sim@n <- sim@n[1:t_idx, , , drop = FALSE] + sim@n_pp <- sim@n_pp[1:t_idx, , drop = FALSE] + sim@n_other <- sim@n_other[1:t_idx, , drop = FALSE] + sim@effort <- sim@effort[1:t_idx, , drop = FALSE] + sim +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 1db5197b..d5a8f6d2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -20,4 +20,7 @@ reference: - displayFrames - getBiomassFrame - getSSBFrame +- title: Others + contents: + - validSim diff --git a/docs/reference/index.html b/docs/reference/index.html index e710921c..3cb15968 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -44,8 +44,6 @@ - - @@ -57,16 +55,9 @@ - - - - - - -