From 83a595ebaf85a59f80a5c4ba545ec53013a35039 Mon Sep 17 00:00:00 2001 From: richardreeve Date: Tue, 20 Dec 2022 01:08:26 +0000 Subject: [PATCH 1/3] Add dependency on RPiR.helper --- DESCRIPTION | 6 ++++-- NAMESPACE | 1 + R/RPiR-package.R | 1 + 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 45af7fb7..8b1858d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Imports: rlang, rmarkdown, roxygen2, + RPiR.helper (>= 0.1.0), rstudioapi, tibble, usethis, @@ -38,8 +39,9 @@ Imports: withr Suggests: testthat -Remotes: - rstudio/gradethis +Remotes: + rstudio/gradethis, + SBOHVM/RPiR.helper Encoding: UTF-8 LazyData: true RoxygenNote: 7.2.3 diff --git a/NAMESPACE b/NAMESPACE index 463ddb3f..a4b52d52 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(run_lecture) export(run_practical) export(run_simple) export(run_simulation) +import(RPiR.helper) import(codetools) import(datasets) import(deSolve) diff --git a/R/RPiR-package.R b/R/RPiR-package.R index 12b69fdd..091f1342 100644 --- a/R/RPiR-package.R +++ b/R/RPiR-package.R @@ -66,6 +66,7 @@ #' @import rstudioapi #' @import usethis #' @import utils +#' @import RPiR.helper #' @importFrom withr with_dir #' #' @examples From c08f20ce41db0a2116390a92580d012c4dea5a48 Mon Sep 17 00:00:00 2001 From: richardreeve Date: Tue, 20 Dec 2022 01:10:42 +0000 Subject: [PATCH 2/3] Re-export RPiR.helper functions --- R/assert_no_globals.R | 32 +--------- R/cleanup.R | 86 +------------------------ R/plot_populations.R | 87 +------------------------- R/plot_simple.R | 68 +------------------- R/run_simple.R | 57 +---------------- R/run_simulation.R | 131 +-------------------------------------- man/assert_no_globals.Rd | 29 --------- man/cleanup_times.Rd | 72 --------------------- man/plot_populations.Rd | 48 -------------- man/plot_simple.Rd | 46 -------------- man/reexports.Rd | 24 +++++++ man/run_simple.Rd | 52 ---------------- man/run_simulation.Rd | 59 ------------------ 13 files changed, 32 insertions(+), 759 deletions(-) delete mode 100644 man/assert_no_globals.Rd delete mode 100644 man/cleanup_times.Rd delete mode 100644 man/plot_populations.Rd delete mode 100644 man/plot_simple.Rd create mode 100644 man/reexports.Rd delete mode 100644 man/run_simple.Rd delete mode 100644 man/run_simulation.Rd diff --git a/R/assert_no_globals.R b/R/assert_no_globals.R index f5a971b3..84da8355 100644 --- a/R/assert_no_globals.R +++ b/R/assert_no_globals.R @@ -1,32 +1,2 @@ -#' Assert that a function contains no global variables -#' -#' This function will stop code execution with an error if the function -#' passed in uses a global variable. -#' -#' @param test_function function to check for global variables -#' @param name (optional) the name of function as a string -- passed to the -#' error message -#' -#' @return nothing #' @export -#' -#' @examples -#' \dontrun{ -#' broken_function <- function() print(y) -#' assert_no_globals(broken_function) -#' assert_no_globals(broken_function, name = "the_name_of_my_function") -#' } -#' -assert_no_globals <- function(test_function, - name = deparse1(substitute(test_function))) { - - globals <- codetools::findGlobals(test_function, merge = FALSE)$variables - message <- paste0("Function ", name, "() may not use global variable(s): ", - globals) - - if (length(globals) != 0) { - stop(message) - } - - NULL -} +RPiR.helper::assert_no_globals diff --git a/R/cleanup.R b/R/cleanup.R index d18c0d46..b17dae2d 100644 --- a/R/cleanup.R +++ b/R/cleanup.R @@ -1,88 +1,8 @@ -#' @title Cleaning up data -#' -#' @description -#' Cleanup times in population data frame, so that they are regularly -#' spaced and stop at the correct time, using either means to -#' interpolate new data points or previous value for events. We assume -#' when the data frame stops before end.time that the state then -#' remaining unchanged. -#' -#' @param populations - a data frame with columns corresponding to different -#' population segments and a 'time' column -#' @param are.events - whether the times in the data frame are events -#' (therefore should take last event to determine state) or not -#' (therefore interpolate) -#' @param timestep - (optionally) timestep required for times - default 1 -#' @param end.time - (optionally) end of simulation time required - default -#' \code{max(populations$time)} -#' @param times - (optionally) vector of times to be reproduced - default -#' \code{seq(from=min(populations$time), to=end.time, by=timestep)} -#' @param ... - pass through arguments for \code{cleanup_events()} and -#' \code{cleanup_timesteps()} to \code{cleanup_times()} -#' -#' @return -#' Revised data frame with correct timings -#' -#' @details -#' \code{cleanup_events()} cleans up times of an event-based population data -#' frame, \code{cleanup_timesteps()} cleans up times of an timestep-based -#' population data frame. -#' #' @export -#' -#' @examples -#' -#' growth <- function(latest.df, growth.rate) { -#' current.count <- latest.df$count -#' growth.num <- current.count * growth.rate -#' next.count <- current.count + growth.num -#' next.time <- latest.df$time + 1 -#' new.df <- data.frame(time=next.time, count=next.count) -#' finished <- next.count == 0 -#' list(updated.pop=new.df, end.experiment=finished) -#' } -#' df <- data.frame(time=0, count=1) -#' results <- run_simulation(growth, df, 100, growth.rate=0.1) -#' plot_populations(results) -#' short.results <- cleanup_timesteps(results, timestep=20, end.time=80) -#' plot_populations(short.results, new.graph=FALSE, lty=2) -#' -cleanup_times <- function(populations, are.events, timestep=1, - end.time = max(populations$time), - times = seq(from = min(populations$time), - to = end.time, by = timestep)) { - if (times[1] < min(populations$time)) - stop("Requested times start before beginning of input data frame") - new.pops <- populations[FALSE,] - for (time in times) { - if (are.events) # If we are event-based, find last event - next.pop <- utils::tail(populations[populations$time <= time,], 1) - else # otherwise - if (any(populations$time > time)) { - # if we are in the middle of a sequence, interpolate - before <- utils::tail(populations[populations$time <= time,], 1) - after <- utils::head(populations[populations$time > time,], 1) - next.pop <- (before * (after$time - time) + - after * (time - before$time)) / - (after$time - before$time) - } else - # if we are at the end, use last step - next.pop <- utils::tail(populations, 1) - next.pop$time <- time - new.pops <- rbind(new.pops, next.pop) - row.names(new.pops) <- NULL - } - new.pops -} +RPiR.helper::cleanup_times -#' @rdname cleanup_times #' @export -cleanup_events <- function(populations, ...) { - cleanup_times(populations, TRUE, ...) -} +RPiR.helper::cleanup_events -#' @rdname cleanup_times #' @export -cleanup_timesteps <- function(populations, ...) { - cleanup_times(populations, FALSE, ...) -} +RPiR.helper::cleanup_timesteps diff --git a/R/plot_populations.R b/R/plot_populations.R index 4c2df216..216f44b8 100644 --- a/R/plot_populations.R +++ b/R/plot_populations.R @@ -1,87 +1,2 @@ -#' @title Plot population(s) against time -#' -#' @description -#' Plot all of the populations in a data frame against time. One column must -#' be called "time" and will be used as the x-axis of the plot. The rest will -#' be used as different lines on the y-axis, with a legend denoting their -#' column names. -#' -#' @param populations Data frame with columns corresponding to different -#' population segments and a 'time' column -#' @param new.graph (optionally) whether to start a new graph, default TRUE -#' @param ylim (optionally, for new graphs) the limits of the y axis, -#' default min to max pop size -#' @param lty (optionally) the line type for the graph, default 1 -#' @param col (optionally) the colour for all lines, -#' default 1:num.populations you can name these c(susceptibles = "green", ...) -#' @param with.legend (optionally) whether to include the legend (TRUE or -#' FALSE), default TRUE -#' @param ... (optionally) any other arguments that plot and lines will both -#' accept -#' #' @export -#' -#' @examples -#' df <- data.frame(time = 0:100, grow = exp((0:100) / 10), -#' die = exp(seq(10, 0, by = -0.1))) -#' plot_populations(df, lty = 2, main = "A title") -#' -plot_populations <- function(populations, new.graph = TRUE, ylim = NA, lty = 1, - col = NA, with.legend = TRUE, ...) { - if (any(colnames(populations) == "time")) { - time <- populations$time - populations$time <- NULL - } - else - stop("No time available") - - # Sort out the line colours for the populations - labels <- colnames(populations) - if (is.na(col[1])) - line.cols <- seq_along(labels) - else { - if (all(labels(col) == seq_along(col))) - line.cols <- rep(col, length.out = length(labels)) - else { - line.cols <- vector() - for (name in labels) - line.cols <- c(line.cols, col[name]) - } - } - - # Sort out the line types for the populations - if (is.na(lty[1])) - line.ltys <- seq_along(labels) - else { - if (all(labels(lty) == seq_along(lty))) - line.ltys <- rep(lty, length.out = length(labels)) - else { - line.ltys <- vector() - for (name in labels) - line.ltys <- c(line.ltys, lty[name]) - } - } - - # Sort out the y limits on the graph if need be - if (is.na(ylim[1])) - ylim <- c(0, max(rowSums(populations))) - - # And now plot the graphs - for (index in seq_along(labels)) { - label <- labels[index] - this.pop <- populations[[label]] - if (new.graph) { - # When it's a new plot, do labels and legends, etc. - plot(time, this.pop, - ylim = ylim, xlab = "time", ylab = "population size", - type = "l", col = line.cols[index], lty = line.ltys[index], ...) - if (with.legend) # Plot the legend if desired - graphics::legend("topright", legend = labels, lty = line.ltys, - col = line.cols) - new.graph <- FALSE - } - else # Otherwise just draw the lines - graphics::lines(time, this.pop, col = line.cols[index], - lty = line.ltys[index], ...) - } -} +RPiR.helper::plot_populations diff --git a/R/plot_simple.R b/R/plot_simple.R index 5bf500ba..b8af3841 100644 --- a/R/plot_simple.R +++ b/R/plot_simple.R @@ -1,68 +1,2 @@ -#' @title Simplest code to plot population(s) against time -#' -#' @description -#' A simple plot all of the populations in a data frame against time. One column -#' must be called "time" and will be used as the x-axis of the plot. The rest -#' will be used as different lines on the y-axis, with a legend denoting their -#' column names. See plot_populations() above for a more sophisticated plotting -#' function. -#' -#' @param populations Data frame with columns corresponding to different -#' population segments and a 'time' column -#' @param new.graph (optional) whether to start a new graph, default TRUE -#' @param xlim (optional, for new graphs) the limits of the x axis, -#' default min to max time -#' @param ylim (optional, for new graphs) the limits of the y axis, -#' default min to max pop size -#' @param lty (optional) the line type for all lines on the graph, default 1 -#' @param legend (optional) legend position; choose from "topleft", "top", -#' "topright" (default), "left", "center", "right", "bottomleft", "bottom", or -#' "bottomright" -#' #' @export -#' -#' @examples -#' df <- data.frame(time = 0:100, grow = exp((0:100) / 10), -#' die = exp(seq(10, 0, by = -0.1))) -#' plot_simple(df, lty = c(2, 3)) -#' -plot_simple <- function(populations, new.graph = TRUE, xlim, ylim, - lty = 1, legend = "topright") { - # First make sure there's a time column in the data frame being plotted - if (any(colnames(populations) == "time")) { - time <- populations$time - populations$time <- NULL - - } else # Otherwise complain and stop... - stop("No time info available - data frame must have a column called 'time'") - - # Get the column names of the data frame to use as labels - labels <- colnames(populations) - # Create our own standard set of colours - line.cols <- seq_along(labels) - - # Get x-limits on graph from input if we haven't set our own - if (missing(xlim)) - xlim <- c(min(time), max(time)) - - # Get y-limits on graph from input if we haven't set our own - if (missing(ylim)) - ylim <- c(0, max(rowSums(populations))) - - # And plot the individual columns against time - for (index in seq_along(labels)) { - label <- labels[index] - this.pop <- populations[[label]] - if (new.graph) { - # Either in a new graph if appropriate - plot(time, this.pop, - xlim = xlim, ylim = ylim, - xlab = "time", ylab = "population size", - type = "l", col = line.cols[index], lty = lty[index]) - graphics::legend(legend, legend = labels, - lty = lty, col = line.cols, box.lty = 0, inset = .02) - new.graph <- FALSE - } else # Or as a new line on an existing graph - graphics::lines(time, this.pop, col = line.cols[index], lty = lty[index]) - } -} +RPiR.helper::plot_simple diff --git a/R/run_simple.R b/R/run_simple.R index ee1f3f8c..2ff13cfb 100644 --- a/R/run_simple.R +++ b/R/run_simple.R @@ -1,57 +1,2 @@ -#' @title Simplest code to run a simulation loop -#' -#' @description -#' A generic function to run a simulation loop for a fixed period of time. -#' \code{run_simple()} will call \code{step_function(initial.pop, ...)} over -#' and over until the time ends or \code{step_function()} reports that the -#' experiment has ended. -#' -#' @seealso \code{\link{run_simulation}} if you want a more flexible version -#' of this function that will allow your \code{step_function()} to return just a -#' data frame and will print some debugging information on request. -#' -#' @param step_function Function to run a timestep (\code{step_function()}) -#' which returns a list containing elements \code{updated.pop} with the -#' updated population and \code{end.experiment} which is TRUE if the -#' experiment has ended (FALSE if not) -#' @param initial.pop Initial population data frame with columns corresponding -#' to function requirements. This *must* include a \code{time} column so that -#' \code{run_simple()} can check whether the \code{end.time} has been reached. -#' @param end.time End time of simulation -#' @param ... (optionally) any other arguments for \code{step_function()}, -#' e.g. parameters or timestep -#' -#' @return Data frame containing population history of simulation over time -#' #' @export -#' -#' @examples -#' growth <- function(latest.df, growth.rate) { -#' current.count <- latest.df$count -#' growth.num <- current.count * growth.rate -#' next.count <- current.count + growth.num -#' next.time <- latest.df$time + 1 -#' new.df <- data.frame(time=next.time, count=next.count) -#' finished <- next.count == 0 -#' list(updated.pop=new.df, end.experiment=finished) -#' } -#' df <- data.frame(time=0, count=1) -#' results <- run_simple(growth, df, 100, growth.rate = 0.1) -#' plot_populations(results) -#' -run_simple <- function(step_function, initial.pop, end.time, ...) { - # Check whether step_function uses global variables - RPiR::assert_no_globals(step_function, - name = deparse1(substitute(step_function))) - - population.df <- latest.df <- initial.pop - keep.going <- (latest.df$time < end.time) - while (keep.going) { - data <- step_function(latest.df, ...) - latest.df <- data$updated.pop - population.df <- rbind(population.df, latest.df) - keep.going <- (latest.df$time < end.time) && (!data$end.experiment) - } - row.names(population.df) <- NULL - population.df -} +RPiR.helper::run_simple diff --git a/R/run_simulation.R b/R/run_simulation.R index 73eee325..3c174ad8 100644 --- a/R/run_simulation.R +++ b/R/run_simulation.R @@ -1,131 +1,2 @@ -#' @title Run a simulation loop -#' -#' @description -#' A generic function to run a simulation loop for a fixed period of time. -#' This function can cope with model step functions that return an updated -#' data frame, or functions that return a list with an \code{end.experiment} -#' element and an \code{updated.pop} element. If the simulation isn't working -#' you can set \code{debug = TRUE} in the arguments, and it will print some -#' (potentially) useful debugging information while it runs. It will also -#' check whether your function has any global variables. -#' -#' @seealso \code{\link{run_simple}} if you want a much simpler but more -#' restrictive version of the simulation code that may be useful for better -#' understanding how the function works. -#' -#' @param step_function Function to run a timestep (\code{step_function()}) -#' which returns a list containing elements \code{updated.pop} with the -#' updated population and \code{end.experiment} which is TRUE if the -#' experiment has ended (FALSE if not), OR which just returns a data frame -#' with the updated population -#' @param initial.pop Initial population data frame with columns corresponding -#' to function requirements. This *must* include a \code{time} column so that -#' \code{run_simple()} can check whether the \code{end.time} has been reached. -#' @param end.time End time of simulation -#' @param debug (optionally) do you want to print out a limited amount of -#' debugging information about your code? - default FALSE -#' @param ... (optionally) any other arguments for \code{step_function()}, -#' e.g. parameters or timestep -#' -#' @return Data frame containing population history of simulation over time -#' #' @export -#' -#' @examples -#' growth <- function(latest.df, growth.rate) { -#' current.count <- latest.df$count -#' growth.num <- current.count * growth.rate -#' next.count <- current.count + growth.num -#' next.time <- latest.df$time + 1 -#' new.df <- data.frame(time=next.time, count=next.count) -#' finished <- next.count == 0 -#' list(updated.pop=new.df, end.experiment=finished) -#' } -#' df <- data.frame(time=0, count=1) -#' results <- run_simulation(growth, df, 100, growth.rate=0.1, debug=TRUE) -#' plot_populations(results) -#' -run_simulation <- function(step_function, initial.pop, end.time, - debug=FALSE, ...) { - # Check whether step_function uses global variables - RPiR::assert_no_globals(step_function, - name = deparse1(substitute(step_function))) - - # Collect and report debugging information to identify sources of errors - pop.names <- colnames(initial.pop) - if (debug) { - cat(c("Population names being used: ", - paste(pop.names, collapse = ", "), "\n")) - if (nrow(initial.pop) != 1) - warning("Input dataframe initial.pop has ", nrow(initial.pop), " rows") - cat(c("Parameter names being used: ", - paste(names(c(...)), collapse = ", "), "\n")) - } - - keep.going <- (initial.pop$time < end.time) - if (debug && keep.going) { - data <- step_function(initial.pop, ...) - if (is.data.frame(data)) { - # We have an experiment that doesn't end, or can't determine when it does - latest.df <- data - ended <- FALSE - cat("step_function() returns a data frame.\n") - } else { - # If a list, we have an experiment that can determine when it ends - cat("step_function() returns a list.\n") - list.names <- c("updated.pop", "end.experiment") - if (any(names(data) != list.names)) { - cat("Names of elements in list: ", - paste(names(data), collapse = ", "), "\n") - if (any(sort(names(data)) != sort(list.names))) - stop("Misnamed list elements returned from step_function(): ", - paste(names(data), collapse = " and "), - ", not updated.pop and end.experiment.") - } - latest.df <- data$updated.pop - ended <- data$end.experiment - cat("end.experiment returned from first run: ", ended, "\n") - } - - cat("Population returned from first run: ", - paste(latest.df, collapse = ", "), "\n") - ret.names <- colnames(latest.df) - if (any(ret.names != pop.names)) { - cat("Population names being used in output: ", - paste(ret.names, collapse = ", "), "\n") - if (any(sort(ret.names) != sort(pop.names))) - stop("Mismatch in input and output population dataframe column names") - else - print("Input and output dataframe column names in different order") - } - population.df <- rbind(initial.pop, latest.df) - keep.going <- (latest.df$time < end.time) && (!ended) - } else { - latest.df <- initial.pop - population.df <- initial.pop - } - - while (keep.going) { - data <- step_function(latest.df, ...) - if (is.data.frame(data)) { - # We have an experiment that doesn't end, or can't determine when it does - latest.df <- data - ended <- FALSE - } - else { # If a list, we have an experiment that can determine when it ends - latest.df <- data$updated.pop - ended <- data$end.experiment - } - - if (debug) { - if (nrow(latest.df) != 1) - cat("Output dataframe has ", nrow(latest.df), " rows\n") - if (any(is.na(latest.df))) - cat("Output dataframe has NAs: ", paste(latest.df, collapse = ", "), "\n") - } - population.df <- rbind(population.df, latest.df) - keep.going <- (latest.df$time < end.time) && (!ended) - } - row.names(population.df) <- NULL - population.df -} +RPiR.helper::run_simulation diff --git a/man/assert_no_globals.Rd b/man/assert_no_globals.Rd deleted file mode 100644 index bb5a7946..00000000 --- a/man/assert_no_globals.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assert_no_globals.R -\name{assert_no_globals} -\alias{assert_no_globals} -\title{Assert that a function contains no global variables} -\usage{ -assert_no_globals(test_function, name = deparse1(substitute(test_function))) -} -\arguments{ -\item{test_function}{function to check for global variables} - -\item{name}{(optional) the name of function as a string -- passed to the -error message} -} -\value{ -nothing -} -\description{ -This function will stop code execution with an error if the function -passed in uses a global variable. -} -\examples{ -\dontrun{ -broken_function <- function() print(y) -assert_no_globals(broken_function) -assert_no_globals(broken_function, name = "the_name_of_my_function") -} - -} diff --git a/man/cleanup_times.Rd b/man/cleanup_times.Rd deleted file mode 100644 index e29af0d1..00000000 --- a/man/cleanup_times.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cleanup.R -\name{cleanup_times} -\alias{cleanup_times} -\alias{cleanup_events} -\alias{cleanup_timesteps} -\title{Cleaning up data} -\usage{ -cleanup_times( - populations, - are.events, - timestep = 1, - end.time = max(populations$time), - times = seq(from = min(populations$time), to = end.time, by = timestep) -) - -cleanup_events(populations, ...) - -cleanup_timesteps(populations, ...) -} -\arguments{ -\item{populations}{- a data frame with columns corresponding to different -population segments and a 'time' column} - -\item{are.events}{- whether the times in the data frame are events -(therefore should take last event to determine state) or not -(therefore interpolate)} - -\item{timestep}{- (optionally) timestep required for times - default 1} - -\item{end.time}{- (optionally) end of simulation time required - default -\code{max(populations$time)}} - -\item{times}{- (optionally) vector of times to be reproduced - default -\code{seq(from=min(populations$time), to=end.time, by=timestep)}} - -\item{...}{- pass through arguments for \code{cleanup_events()} and -\code{cleanup_timesteps()} to \code{cleanup_times()}} -} -\value{ -Revised data frame with correct timings -} -\description{ -Cleanup times in population data frame, so that they are regularly -spaced and stop at the correct time, using either means to -interpolate new data points or previous value for events. We assume -when the data frame stops before end.time that the state then -remaining unchanged. -} -\details{ -\code{cleanup_events()} cleans up times of an event-based population data -frame, \code{cleanup_timesteps()} cleans up times of an timestep-based -population data frame. -} -\examples{ - -growth <- function(latest.df, growth.rate) { -current.count <- latest.df$count -growth.num <- current.count * growth.rate -next.count <- current.count + growth.num -next.time <- latest.df$time + 1 -new.df <- data.frame(time=next.time, count=next.count) -finished <- next.count == 0 -list(updated.pop=new.df, end.experiment=finished) -} -df <- data.frame(time=0, count=1) -results <- run_simulation(growth, df, 100, growth.rate=0.1) -plot_populations(results) -short.results <- cleanup_timesteps(results, timestep=20, end.time=80) -plot_populations(short.results, new.graph=FALSE, lty=2) - -} diff --git a/man/plot_populations.Rd b/man/plot_populations.Rd deleted file mode 100644 index 9a44a2ba..00000000 --- a/man/plot_populations.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_populations.R -\name{plot_populations} -\alias{plot_populations} -\title{Plot population(s) against time} -\usage{ -plot_populations( - populations, - new.graph = TRUE, - ylim = NA, - lty = 1, - col = NA, - with.legend = TRUE, - ... -) -} -\arguments{ -\item{populations}{Data frame with columns corresponding to different -population segments and a 'time' column} - -\item{new.graph}{(optionally) whether to start a new graph, default TRUE} - -\item{ylim}{(optionally, for new graphs) the limits of the y axis, -default min to max pop size} - -\item{lty}{(optionally) the line type for the graph, default 1} - -\item{col}{(optionally) the colour for all lines, -default 1:num.populations you can name these c(susceptibles = "green", ...)} - -\item{with.legend}{(optionally) whether to include the legend (TRUE or -FALSE), default TRUE} - -\item{...}{(optionally) any other arguments that plot and lines will both -accept} -} -\description{ -Plot all of the populations in a data frame against time. One column must -be called "time" and will be used as the x-axis of the plot. The rest will -be used as different lines on the y-axis, with a legend denoting their -column names. -} -\examples{ -df <- data.frame(time = 0:100, grow = exp((0:100) / 10), - die = exp(seq(10, 0, by = -0.1))) -plot_populations(df, lty = 2, main = "A title") - -} diff --git a/man/plot_simple.Rd b/man/plot_simple.Rd deleted file mode 100644 index 03ad136a..00000000 --- a/man/plot_simple.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot_simple.R -\name{plot_simple} -\alias{plot_simple} -\title{Simplest code to plot population(s) against time} -\usage{ -plot_simple( - populations, - new.graph = TRUE, - xlim, - ylim, - lty = 1, - legend = "topright" -) -} -\arguments{ -\item{populations}{Data frame with columns corresponding to different -population segments and a 'time' column} - -\item{new.graph}{(optional) whether to start a new graph, default TRUE} - -\item{xlim}{(optional, for new graphs) the limits of the x axis, -default min to max time} - -\item{ylim}{(optional, for new graphs) the limits of the y axis, -default min to max pop size} - -\item{lty}{(optional) the line type for all lines on the graph, default 1} - -\item{legend}{(optional) legend position; choose from "topleft", "top", -"topright" (default), "left", "center", "right", "bottomleft", "bottom", or -"bottomright"} -} -\description{ -A simple plot all of the populations in a data frame against time. One column -must be called "time" and will be used as the x-axis of the plot. The rest -will be used as different lines on the y-axis, with a legend denoting their -column names. See plot_populations() above for a more sophisticated plotting -function. -} -\examples{ -df <- data.frame(time = 0:100, grow = exp((0:100) / 10), - die = exp(seq(10, 0, by = -0.1))) -plot_simple(df, lty = c(2, 3)) - -} diff --git a/man/reexports.Rd b/man/reexports.Rd new file mode 100644 index 00000000..1232da4b --- /dev/null +++ b/man/reexports.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assert_no_globals.R, R/cleanup.R, +% R/plot_populations.R, R/plot_simple.R, R/run_simple.R, R/run_simulation.R +\docType{import} +\name{reexports} +\alias{reexports} +\alias{assert_no_globals} +\alias{cleanup_times} +\alias{cleanup_events} +\alias{cleanup_timesteps} +\alias{plot_populations} +\alias{plot_simple} +\alias{run_simple} +\alias{run_simulation} +\title{Objects exported from other packages} +\keyword{internal} +\description{ +These objects are imported from other packages. Follow the links +below to see their documentation. + +\describe{ + \item{RPiR.helper}{\code{\link[RPiR.helper]{assert_no_globals}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_events}}, \code{\link[RPiR.helper]{cleanup_times}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_timesteps}}, \code{\link[RPiR.helper]{plot_populations}}, \code{\link[RPiR.helper]{plot_simple}}, \code{\link[RPiR.helper]{run_simple}}, \code{\link[RPiR.helper]{run_simulation}}} +}} + diff --git a/man/run_simple.Rd b/man/run_simple.Rd deleted file mode 100644 index a8e67368..00000000 --- a/man/run_simple.Rd +++ /dev/null @@ -1,52 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_simple.R -\name{run_simple} -\alias{run_simple} -\title{Simplest code to run a simulation loop} -\usage{ -run_simple(step_function, initial.pop, end.time, ...) -} -\arguments{ -\item{step_function}{Function to run a timestep (\code{step_function()}) -which returns a list containing elements \code{updated.pop} with the -updated population and \code{end.experiment} which is TRUE if the -experiment has ended (FALSE if not)} - -\item{initial.pop}{Initial population data frame with columns corresponding -to function requirements. This *must* include a \code{time} column so that -\code{run_simple()} can check whether the \code{end.time} has been reached.} - -\item{end.time}{End time of simulation} - -\item{...}{(optionally) any other arguments for \code{step_function()}, -e.g. parameters or timestep} -} -\value{ -Data frame containing population history of simulation over time -} -\description{ -A generic function to run a simulation loop for a fixed period of time. -\code{run_simple()} will call \code{step_function(initial.pop, ...)} over -and over until the time ends or \code{step_function()} reports that the -experiment has ended. -} -\examples{ -growth <- function(latest.df, growth.rate) { -current.count <- latest.df$count -growth.num <- current.count * growth.rate -next.count <- current.count + growth.num -next.time <- latest.df$time + 1 -new.df <- data.frame(time=next.time, count=next.count) -finished <- next.count == 0 -list(updated.pop=new.df, end.experiment=finished) -} -df <- data.frame(time=0, count=1) -results <- run_simple(growth, df, 100, growth.rate = 0.1) -plot_populations(results) - -} -\seealso{ -\code{\link{run_simulation}} if you want a more flexible version -of this function that will allow your \code{step_function()} to return just a -data frame and will print some debugging information on request. -} diff --git a/man/run_simulation.Rd b/man/run_simulation.Rd deleted file mode 100644 index d42120b1..00000000 --- a/man/run_simulation.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_simulation.R -\name{run_simulation} -\alias{run_simulation} -\title{Run a simulation loop} -\usage{ -run_simulation(step_function, initial.pop, end.time, debug = FALSE, ...) -} -\arguments{ -\item{step_function}{Function to run a timestep (\code{step_function()}) -which returns a list containing elements \code{updated.pop} with the -updated population and \code{end.experiment} which is TRUE if the -experiment has ended (FALSE if not), OR which just returns a data frame -with the updated population} - -\item{initial.pop}{Initial population data frame with columns corresponding -to function requirements. This *must* include a \code{time} column so that -\code{run_simple()} can check whether the \code{end.time} has been reached.} - -\item{end.time}{End time of simulation} - -\item{debug}{(optionally) do you want to print out a limited amount of -debugging information about your code? - default FALSE} - -\item{...}{(optionally) any other arguments for \code{step_function()}, -e.g. parameters or timestep} -} -\value{ -Data frame containing population history of simulation over time -} -\description{ -A generic function to run a simulation loop for a fixed period of time. -This function can cope with model step functions that return an updated -data frame, or functions that return a list with an \code{end.experiment} -element and an \code{updated.pop} element. If the simulation isn't working -you can set \code{debug = TRUE} in the arguments, and it will print some -(potentially) useful debugging information while it runs. It will also -check whether your function has any global variables. -} -\examples{ -growth <- function(latest.df, growth.rate) { -current.count <- latest.df$count -growth.num <- current.count * growth.rate -next.count <- current.count + growth.num -next.time <- latest.df$time + 1 -new.df <- data.frame(time=next.time, count=next.count) -finished <- next.count == 0 -list(updated.pop=new.df, end.experiment=finished) -} -df <- data.frame(time=0, count=1) -results <- run_simulation(growth, df, 100, growth.rate=0.1, debug=TRUE) -plot_populations(results) - -} -\seealso{ -\code{\link{run_simple}} if you want a much simpler but more -restrictive version of the simulation code that may be useful for better -understanding how the function works. -} From 8ebd5b70408f60f1329095d5bb55dfb40a318f7e Mon Sep 17 00:00:00 2001 From: richardreeve Date: Tue, 20 Dec 2022 01:33:05 +0000 Subject: [PATCH 3/3] run_integration() now in RPiR.helper --- R/run_integration.R | 61 +----------------------------------------- man/reexports.Rd | 6 +++-- man/run_integration.Rd | 43 ----------------------------- 3 files changed, 5 insertions(+), 105 deletions(-) delete mode 100644 man/run_integration.Rd diff --git a/R/run_integration.R b/R/run_integration.R index 1fab0dc3..11c5113e 100644 --- a/R/run_integration.R +++ b/R/run_integration.R @@ -1,61 +1,2 @@ -#' @title Run an integration over time -#' -#' @description -#' A generic function to integrate a series of ODEs. Designed to -#' have arguments compatible with other run_xxx() functions, rather than -#' optimally designed for ode(). deriv_function must have three arguments (t, -#' pop_vec, param_vec), where t is the time, pop_vec contains the current state -#' of the population in a vector with named elements, and param_vec contains a -#' vector of named parameters. It must return a list with two elements, the -#' first of which is a vector of the derivatives of the population at pop_vec, -#' and the second is an empty vector. -#' -#' @param deriv_function Function to calculate derivative -#' @param populations Data frame with columns corresponding to function -#' requirements -#' @param end.time End time of simulation -#' @param timestep (optionally) record the state every timestep - default 1 -#' @param debug (optionally) Do you want to print out a limited amount of -#' debugging information about your code? - default FALSE -#' @param ... Other arguments for deriv_function, mostly parameters -#' -#' @return Data frame containing population history of simulation over time -#' #' @export -#' -run_integration <- function(deriv_function, populations, end.time, - timestep = 1, debug = FALSE, ...) { - if (length(codetools::findGlobals(deriv_function, merge = FALSE)$variables) > 0) - warning(paste("Function provided uses global variable(s):", - paste(codetools::findGlobals(deriv_function, - merge = FALSE)$variables, - collapse = ", "))) - if (debug) { - cat(c("Population names being used: ", - paste(colnames(populations), collapse = ", "), - "\n")) - cat(c("Parameter names being used: ", - paste(names(c(...)), collapse = ", "), - "\n")) - } - # Translate run.integration parameters into ones for ode() - current.time <- utils::tail(populations$time, 1) - times <- seq(from = current.time, to = end.time, by = timestep) - initial.populations <- unlist(populations) - initial.populations <- initial.populations[names(initial.populations) != "time"] - params <- c(...) - - if (debug) { - cat("Derivatives returned from first run: ", - paste(deriv_function(current.time, initial.populations, params)[[1]], - collapse = ", "), - "\n") - } - - # Now run ode, turn back into data frame, add times and return - matrix.populations <- deSolve::ode(initial.populations, times, - deriv_function, params) - final.populations <- as.data.frame(matrix.populations) - final.populations$time <- times - final.populations -} +RPiR.helper::run_integration diff --git a/man/reexports.Rd b/man/reexports.Rd index 1232da4b..d02b96dc 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/assert_no_globals.R, R/cleanup.R, -% R/plot_populations.R, R/plot_simple.R, R/run_simple.R, R/run_simulation.R +% R/plot_populations.R, R/plot_simple.R, R/run_integration.R, R/run_simple.R, +% R/run_simulation.R \docType{import} \name{reexports} \alias{reexports} @@ -10,6 +11,7 @@ \alias{cleanup_timesteps} \alias{plot_populations} \alias{plot_simple} +\alias{run_integration} \alias{run_simple} \alias{run_simulation} \title{Objects exported from other packages} @@ -19,6 +21,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{RPiR.helper}{\code{\link[RPiR.helper]{assert_no_globals}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_events}}, \code{\link[RPiR.helper]{cleanup_times}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_timesteps}}, \code{\link[RPiR.helper]{plot_populations}}, \code{\link[RPiR.helper]{plot_simple}}, \code{\link[RPiR.helper]{run_simple}}, \code{\link[RPiR.helper]{run_simulation}}} + \item{RPiR.helper}{\code{\link[RPiR.helper]{assert_no_globals}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_events}}, \code{\link[RPiR.helper]{cleanup_times}}, \code{\link[RPiR.helper:cleanup_times]{cleanup_timesteps}}, \code{\link[RPiR.helper]{plot_populations}}, \code{\link[RPiR.helper]{plot_simple}}, \code{\link[RPiR.helper]{run_integration}}, \code{\link[RPiR.helper]{run_simple}}, \code{\link[RPiR.helper]{run_simulation}}} }} diff --git a/man/run_integration.Rd b/man/run_integration.Rd deleted file mode 100644 index 22d3881d..00000000 --- a/man/run_integration.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_integration.R -\name{run_integration} -\alias{run_integration} -\title{Run an integration over time} -\usage{ -run_integration( - deriv_function, - populations, - end.time, - timestep = 1, - debug = FALSE, - ... -) -} -\arguments{ -\item{deriv_function}{Function to calculate derivative} - -\item{populations}{Data frame with columns corresponding to function -requirements} - -\item{end.time}{End time of simulation} - -\item{timestep}{(optionally) record the state every timestep - default 1} - -\item{debug}{(optionally) Do you want to print out a limited amount of -debugging information about your code? - default FALSE} - -\item{...}{Other arguments for deriv_function, mostly parameters} -} -\value{ -Data frame containing population history of simulation over time -} -\description{ -A generic function to integrate a series of ODEs. Designed to -have arguments compatible with other run_xxx() functions, rather than -optimally designed for ode(). deriv_function must have three arguments (t, -pop_vec, param_vec), where t is the time, pop_vec contains the current state -of the population in a vector with named elements, and param_vec contains a -vector of named parameters. It must return a list with two elements, the -first of which is a vector of the derivatives of the population at pop_vec, -and the second is an empty vector. -}