Move helper functions into RPiR.helper

DESCRIPTION

@@ -31,15 +31,17 @@ Imports:
     rlang,
     rmarkdown,
     roxygen2,
+    RPiR.helper (>= 0.1.0),
     rstudioapi,
     tibble,
     usethis,
     utils,
     withr
 Suggests:
     testthat
-Remotes: 
-    rstudio/gradethis
+Remotes:  
+    rstudio/gradethis,
+    SBOHVM/RPiR.helper
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.2.3

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)

R/RPiR-package.R

@@ -66,6 +66,7 @@
 #' @import rstudioapi
 #' @import usethis
 #' @import utils
+#' @import RPiR.helper
 #' @importFrom withr with_dir
 #'
 #' @examples

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

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

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

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

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