R/simPregSamp.R

In simPreg: Simulate Pregnancy Data with Time-Varying Exposure

#' Sample pregnancies from simulated distributions
#'
#' Generates a sample of pregnancy outcomes from the proportions produced by
#' `simPregProp()`.
#'
#' @param df A data frame with class `preg.prop`, such as the output from
#'   `simPregProp()`.
#' @param n Number of pregnancies to sample. Must be a positive integer.
#' @param expand Logical value indicating whether to expand the sampled
#'   counts into one row per pregnancy. Defaults to `FALSE`.
#'
#' @return A data frame with class `data.frame` containing the sampled
#'   pregnancy outcomes and their frequencies. The returned data frame retains
#'   the columns of `df` and includes an additional `Freq` column containing
#'   the number of sampled pregnancies for each gestational age, exposure
#'   timing, and outcome combination.
#'
#'   If `expand = TRUE`, rows are expanded so that each row represents one
#'   pregnancy, and `Freq` is set to 1.
#'
#' @examples
#' # Generate pregnancy outcome proportions
#' data.prop <- simPregProp()
#'
#' # Sample 1000 pregnancies
#' data.samp <- simPregSamp(data.prop, 1000)
#' head(data.samp)
#'
#' # Expand to one row per pregnancy
#' data.samp <- simPregSamp(data.prop, 1000, expand = TRUE)
#' head(data.samp)
#'
#' @importFrom stats rmultinom
#' @export
simPregSamp <- function(df, n, expand = FALSE){

  # Check input arguments
  if (length(n) != 1 ||
      !is.numeric(n) ||
      is.na(n) ||
      !is.finite(n) ||
      n < 1 ||
      n %% 1 != 0) {
    stop("'n' must be a positive integer.", call. = FALSE)
  }
  if (!inherits(df, "preg.prop") ||
      !is.data.frame(df)) {
    stop("'df' must be a data frame with class 'preg.prop'.", call. = FALSE)
  }
  if(!"Prop" %in% names(df)){
    stop("'df' is missing required column 'Prop'.", call. = FALSE)
  }
  if (!is.numeric(df$Prop) ||
      anyNA(df$Prop) ||
      any(!is.finite(df$Prop)) ||
      any(df$Prop < 0)) {
    stop("'df$Prop' must be a finite numeric vector of non-negative proportions.", call. = FALSE)
  }
  if (!isTRUE(all.equal(sum(df$Prop), 1))) {
    warning("'df$Prop' does not sum to 1; values will be normalized.",
            call. = FALSE)
  }
  if (length(expand) != 1 || !is.logical(expand) || is.na(expand)) {
    stop("'expand' must be a single TRUE or FALSE value.", call. = FALSE)
  }

  # Sample counts
  df$Freq <- rmultinom(1, size = n, prob = df$Prop)

  # Remove combinations with zero counts
  df <- subset(df, subset = df$Freq != 0)

  # Expand rows according to counts
  if (expand) {
    df <- df[rep(seq_len(nrow(df)), df$Freq),]
    df$Freq <- 1
  }

  # Remove row names and define class
  rownames(df) <- NULL
  class(df) <- setdiff(class(df), "preg.prop")

  # Return
  return(df)
}