diff --git a/NAMESPACE b/NAMESPACE index 8d437a4d8..12213451f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,14 +3,14 @@ S3method(add_mean_sd,default) S3method(add_mean_sd,gamma_samples) S3method(add_mean_sd,lognormal_samples) -S3method(as_direct_model,epidist_linelist) -S3method(as_epidist_linelist,data.frame) -S3method(as_epidist_linelist,default) -S3method(as_latent_individual,epidist_linelist) +S3method(as_direct_model,epidist_linelist_data) +S3method(as_epidist_linelist_data,data.frame) +S3method(as_epidist_linelist_data,default) +S3method(as_latent_individual,epidist_linelist_data) S3method(assert_epidist,default) S3method(assert_epidist,epidist_direct_model) S3method(assert_epidist,epidist_latent_individual) -S3method(assert_epidist,epidist_linelist) +S3method(assert_epidist,epidist_linelist_data) S3method(epidist,default) S3method(epidist_family_model,default) S3method(epidist_family_model,epidist_latent_individual) @@ -25,7 +25,7 @@ S3method(epidist_stancode,default) S3method(epidist_stancode,epidist_latent_individual) export(add_mean_sd) export(as_direct_model) -export(as_epidist_linelist) +export(as_epidist_linelist_data) export(as_latent_individual) export(assert_epidist) export(epidist) @@ -40,11 +40,11 @@ export(epidist_model_prior) export(epidist_prior) export(epidist_stancode) export(is_direct_model) -export(is_epidist_linelist) +export(is_epidist_linelist_data) export(is_latent_individual) export(new_epidist_direct_model) export(new_epidist_latent_individual) -export(new_epidist_linelist) +export(new_epidist_linelist_data) export(observe_process) export(predict_delay_parameters) export(predict_dpar) @@ -57,18 +57,21 @@ importFrom(brms,bf) importFrom(brms,prior) importFrom(checkmate,assert_class) importFrom(checkmate,assert_data_frame) +importFrom(checkmate,assert_date) importFrom(checkmate,assert_factor) importFrom(checkmate,assert_integer) importFrom(checkmate,assert_names) importFrom(checkmate,assert_numeric) importFrom(checkmate,assert_true) importFrom(cli,cli_abort) +importFrom(cli,cli_alert_info) importFrom(cli,cli_inform) importFrom(cli,cli_warn) importFrom(dplyr,bind_cols) importFrom(dplyr,filter) importFrom(dplyr,mutate) importFrom(dplyr,select) +importFrom(lubridate,days) importFrom(stats,as.formula) importFrom(stats,setNames) importFrom(tibble,tibble) diff --git a/R/direct_model.R b/R/direct_model.R index 43862fd67..0209eaf9e 100644 --- a/R/direct_model.R +++ b/R/direct_model.R @@ -7,14 +7,14 @@ as_direct_model <- function(data) { UseMethod("as_direct_model") } -#' The direct model method for `epidist_linelist` objects +#' The direct model method for `epidist_linelist_data` objects #' -#' @param data An `epidist_linelist` object -#' @method as_direct_model epidist_linelist +#' @param data An `epidist_linelist_data` object +#' @method as_direct_model epidist_linelist_data #' @family direct_model #' @autoglobal #' @export -as_direct_model.epidist_linelist <- function(data) { +as_direct_model.epidist_linelist_data <- function(data) { assert_epidist(data) data <- data |> diff --git a/R/latent_individual.R b/R/latent_individual.R index fc3b0d5d0..22c633d3f 100644 --- a/R/latent_individual.R +++ b/R/latent_individual.R @@ -7,11 +7,11 @@ as_latent_individual <- function(data) { UseMethod("as_latent_individual") } -#' @method as_latent_individual epidist_linelist +#' @method as_latent_individual epidist_linelist_data #' @family latent_individual #' @autoglobal #' @export -as_latent_individual.epidist_linelist <- function(data) { +as_latent_individual.epidist_linelist_data <- function(data) { assert_epidist(data) data <- data |> mutate( diff --git a/R/linelist.R b/R/linelist.R deleted file mode 100644 index 239e7b9f9..000000000 --- a/R/linelist.R +++ /dev/null @@ -1,142 +0,0 @@ -#' Create an epidist_linelist object -#' -#' @param data The data to convert -#' @param ... Additional arguments passed to methods -#' @family linelist -#' @export -as_epidist_linelist <- function(data, ...) { - UseMethod("as_epidist_linelist") -} - -#' Create an epidist_linelist object from vectors of event times -#' -#' @param data Numeric vector giving lower bounds for primary times -#' @param ptime_upr Numeric vector giving upper bounds for primary times -#' @param stime_lwr,stime_upr Numeric vectors giving lower and upper bounds for -#' secondary times -#' @param obs_time Numeric vector giving observation times -#' @param ... Additional columns to add to the epidist_linelist object -#' @importFrom tibble tibble -#' @importFrom dplyr bind_cols -#' @family linelist -#' @export -as_epidist_linelist.default <- function( - data, ptime_upr = NULL, stime_lwr = NULL, stime_upr = NULL, - obs_time = NULL, ... -) { - # Create base data frame with required columns - df <- tibble( - ptime_lwr = data, - ptime_upr = ptime_upr, - stime_lwr = stime_lwr, - stime_upr = stime_upr, - obs_time = obs_time - ) - - # Add any additional columns passed via ... - extra_cols <- list(...) - if (length(extra_cols) > 0) { - df <- bind_cols(df, extra_cols) - } - - df <- new_epidist_linelist(df) - assert_epidist(df) - - return(df) -} - -#' Create an epidist_linelist object from a data frame with event dates -#' -#' @param data A data.frame containing line list data -#' @param pdate_lwr,pdate_upr,sdate_lwr,sdate_upr Strings giving the column of -#' `data` containing the primary and secondary event upper and lower bounds. -#' These columns of `data` must be as datetime. -#' @param obs_date A string giving the column of `data` containing the -#' observation time as a datetime. -#' @param ... Additional arguments passed to methods -#' @family linelist -#' @importFrom dplyr bind_cols -#' @export -as_epidist_linelist.data.frame <- function( - data, pdate_lwr = NULL, pdate_upr = NULL, sdate_lwr = NULL, sdate_upr = NULL, - obs_date = NULL, ... -) { - df <- .rename_columns(data, - new_names = c( - "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" - ), - old_names = c(pdate_lwr, pdate_upr, sdate_lwr, sdate_upr, obs_date) - ) - - col_names <- c( - "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" - ) - assert_names(names(df), must.include = col_names) - - # Check for being a datetime - assert_true(any(inherits(df$pdate_lwr, c("POSIXct", "POSIXlt")))) - assert_true(any(inherits(df$pdate_upr, c("POSIXct", "POSIXlt")))) - assert_true(any(inherits(df$sdate_lwr, c("POSIXct", "POSIXlt")))) - assert_true(any(inherits(df$sdate_upr, c("POSIXct", "POSIXlt")))) - assert_true(any(inherits(df$obs_date, c("POSIXct", "POSIXlt")))) - - # Convert datetime to time - min_date <- min(df$pdate_lwr) - - # Convert to numeric times and use default method - - result <- as_epidist_linelist.default( - data = as.numeric(df$pdate_lwr - min_date), - ptime_upr = as.numeric(df$pdate_upr - min_date), - stime_lwr = as.numeric(df$sdate_lwr - min_date), - stime_upr = as.numeric(df$sdate_upr - min_date), - obs_time = as.numeric(df$obs_date - min_date) - ) - - result <- bind_cols(result, df) - - return(result) -} - -#' Class constructor for `epidist_linelist` objects -#' -#' @param data A data.frame to convert -#' @returns An object of class `epidist_linelist` -#' @family linelist -#' @export -new_epidist_linelist <- function(data) { - class(data) <- c("epidist_linelist", class(data)) - return(data) -} - -#' Check if data has the `epidist_linelist` class -#' -#' @inheritParams as_epidist_linelist -#' @param ... Additional arguments -#' @family linelist -#' @export -is_epidist_linelist <- function(data, ...) { - inherits(data, "epidist_linelist") -} - -#' Assert validity of `epidist_linelist` objects -#' -#' @method assert_epidist epidist_linelist -#' @family linelist -#' @export -assert_epidist.epidist_linelist <- function(data, ...) { - assert_data_frame(data) - col_names <- c( - "ptime_lwr", "ptime_upr", "stime_lwr", "stime_upr", "obs_time" - ) - assert_names(names(data), must.include = col_names) - assert_numeric(data$ptime_lwr, lower = 0) - assert_numeric(data$ptime_upr, lower = 0) - assert_true(all(data$ptime_upr - data$ptime_lwr > 0)) - assert_numeric(data$stime_lwr, lower = 0) - assert_numeric(data$stime_upr, lower = 0) - assert_true(all(data$stime_upr - data$stime_lwr > 0)) - assert_numeric(data$obs_time, lower = 0) - - return(invisible(NULL)) -} diff --git a/R/linelist_data.R b/R/linelist_data.R new file mode 100644 index 000000000..26fcd0aa5 --- /dev/null +++ b/R/linelist_data.R @@ -0,0 +1,203 @@ +#' Create an epidist_linelist_data object +#' +#' @param data The data to convert +#' @param ... Additional arguments passed to methods +#' @family linelist_data +#' @export +as_epidist_linelist_data <- function(data, ...) { + UseMethod("as_epidist_linelist_data") +} + +#' Create an epidist_linelist_data object from vectors of event times +#' +#' @param data Numeric vector giving lower bounds for primary times +#' @param ptime_upr Numeric vector giving upper bounds for primary times +#' @param stime_lwr,stime_upr Numeric vectors giving lower and upper bounds for +#' secondary times +#' @param obs_time Numeric vector giving observation times +#' @param ... Additional columns to add to the epidist_linelist_data object +#' @importFrom tibble tibble +#' @importFrom dplyr bind_cols +#' @family linelist_data +#' @export +as_epidist_linelist_data.default <- function( + data, ptime_upr = NULL, stime_lwr = NULL, stime_upr = NULL, + obs_time = NULL, ... +) { + # Create base data frame with required columns + df <- tibble( + ptime_lwr = data, + ptime_upr = ptime_upr, + stime_lwr = stime_lwr, + stime_upr = stime_upr, + obs_time = obs_time + ) + + # Add any additional columns passed via ... + extra_cols <- list(...) + if (length(extra_cols) > 0) { + df <- bind_cols(df, extra_cols) + } + + df <- new_epidist_linelist_data(df) + assert_epidist(df) + + return(df) +} + +#' Create an epidist_linelist_data object from a data frame with event dates +#' +#' @param data A data.frame containing line list data +#' +#' @param pdate_lwr A string giving the column of `data` containing the primary +#' event lower bound as a datetime. Defaults to `NULL` which assumes that the +#' variable `pdate_lwr` is present. +#' +#' @param pdate_upr A string giving the column of `data` containing the primary +#' event upper bound as a datetime. If this column exists in the data it will be +#' used, otherwise if not supplied then the value of `pdate_lwr` + 1 day is +#' used. +#' +#' @param sdate_lwr A string giving the column of `data` containing the +#' secondary event lower bound as a datetime. Defaults to `NULL` which assumes +#' that the variable `sdate_lwr` is present. +#' +#' @param sdate_upr A string giving the column of `data` containing the +#' secondary event upper bound as a datetime. If this column exists in the data +#' it will be used, otherwise if not supplied then the value of `sdate_lwr` + 1 +#' day is used. +#' +#' @param obs_date A string giving the column of `data` containing the +#' observation time as a datetime. Optional, if not supplied then the maximum of +#' `sdate_upr` is used. +#' +#' @param ... Additional arguments passed to methods +#' @family linelist_data +#' @importFrom dplyr bind_cols +#' @importFrom lubridate days +#' @importFrom cli cli_abort cli_alert_info +#' @importFrom checkmate assert_true assert_names assert_numeric assert_date +#' @export +as_epidist_linelist_data.data.frame <- function( + data, pdate_lwr = NULL, sdate_lwr = NULL, pdate_upr = NULL, sdate_upr = NULL, + obs_date = NULL, ... +) { + if (is.null(pdate_lwr) && !hasName(data, "pdate_lwr")) { + cli::cli_abort("{.var pdate_lwr} is NULL but must be provided.") + } + + if (is.null(sdate_lwr) && !hasName(data, "sdate_lwr")) { + cli::cli_abort("{.var sdate_lwr} is NULL but must be provided.") + } + + # Only include non-null inputs in renaming + valid_inputs <- !sapply( + list(pdate_lwr, pdate_upr, sdate_lwr, sdate_upr, obs_date), + is.null + ) + new_names <- c( + "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" + ) + old_names <- c(pdate_lwr, pdate_upr, sdate_lwr, sdate_upr, obs_date) + df <- .rename_columns(data, + new_names = new_names[valid_inputs], + old_names = old_names + ) + + if (!hasName(df, "pdate_upr")) { + cli::cli_alert_info(paste0( + "No primary event upper bound provided, using the primary event lower ", + "bound + 1 day as the assumed upper bound." + )) + df <- mutate(df, pdate_upr = pdate_lwr + lubridate::days(1)) + } + + if (!hasName(df, "sdate_upr")) { + cli::cli_alert_info(paste0( + "No secondary event upper bound provided, using the secondary event", + " lower bound + 1 day as the assumed upper bound." + )) + df <- mutate(df, sdate_upr = sdate_lwr + lubridate::days(1)) + } + + if (!hasName(df, "obs_date")) { + cli::cli_alert_info(paste0( + "No observation time column provided, using ", max(df$sdate_upr), + " as the observation date (the maximum of the secondary event upper ", + "bound)." + )) + df <- mutate(df, obs_date = max(sdate_upr)) + } + + col_names <- c( + "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" + ) + assert_names(names(df), must.include = col_names) + + # Check for being a datetime + assert_date(df$pdate_lwr) + assert_date(df$pdate_upr) + assert_date(df$sdate_lwr) + assert_date(df$sdate_upr) + assert_date(df$obs_date) + + # Convert datetime to time + min_date <- min(df$pdate_lwr) + + # Convert to numeric times and use default method + + result <- as_epidist_linelist_data.default( + data = as.numeric(df$pdate_lwr - min_date), + ptime_upr = as.numeric(df$pdate_upr - min_date), + stime_lwr = as.numeric(df$sdate_lwr - min_date), + stime_upr = as.numeric(df$sdate_upr - min_date), + obs_time = as.numeric(df$obs_date - min_date) + ) + + result <- bind_cols(result, df) + + return(result) +} + +#' Class constructor for `epidist_linelist_data` objects +#' +#' @param data A data.frame to convert +#' @returns An object of class `epidist_linelist_data` +#' @family linelist_data +#' @export +new_epidist_linelist_data <- function(data) { + class(data) <- c("epidist_linelist_data", class(data)) + return(data) +} + +#' Check if data has the `epidist_linelist_data` class +#' +#' @inheritParams as_epidist_linelist_data +#' @param ... Additional arguments +#' @family linelist_data +#' @export +is_epidist_linelist_data <- function(data, ...) { + inherits(data, "epidist_linelist_data") +} + +#' Assert validity of `epidist_linelist_data` objects +#' +#' @method assert_epidist epidist_linelist_data +#' @family linelist_data +#' @export +assert_epidist.epidist_linelist_data <- function(data, ...) { + assert_data_frame(data) + col_names <- c( + "ptime_lwr", "ptime_upr", "stime_lwr", "stime_upr", "obs_time" + ) + assert_names(names(data), must.include = col_names) + assert_numeric(data$ptime_lwr, lower = 0) + assert_numeric(data$ptime_upr, lower = 0) + assert_true(all(data$ptime_upr - data$ptime_lwr > 0)) + assert_numeric(data$stime_lwr, lower = 0) + assert_numeric(data$stime_upr, lower = 0) + assert_true(all(data$stime_upr - data$stime_lwr > 0)) + assert_numeric(data$obs_time, lower = 0) + + return(invisible(NULL)) +} diff --git a/R/utils.R b/R/utils.R index 6f5990ff3..9598171c8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -135,12 +135,24 @@ #' @keywords internal #' @importFrom stats setNames .rename_columns <- function(df, new_names, old_names) { - are_char <- is.character(new_names) & is.character(old_names) - valid_new_names <- new_names[are_char] - valid_old_names <- old_names[are_char] - if (length(are_char) > 0) { + are_valid <- is.character(new_names) & is.character(old_names) + + valid_new_names <- new_names[are_valid] + valid_old_names <- old_names[are_valid] + + # Check if old names exist in dataframe + missing_cols <- setdiff(valid_old_names, names(df)) + if (length(missing_cols) > 0) { + cli::cli_abort(paste0( + "The following columns are not present in the data: ", + paste(missing_cols, collapse = ", ") + )) + } + + if (length(valid_new_names) > 0) { rename_map <- setNames(valid_old_names, valid_new_names) df <- dplyr::rename(df, !!!rename_map) } + return(df) } diff --git a/man/as_direct_model.Rd b/man/as_direct_model.Rd index 49354315a..7a70b25c8 100644 --- a/man/as_direct_model.Rd +++ b/man/as_direct_model.Rd @@ -14,7 +14,7 @@ Prepare direct model to pass through to \code{brms} } \seealso{ Other direct_model: -\code{\link{as_direct_model.epidist_linelist}()}, +\code{\link{as_direct_model.epidist_linelist_data}()}, \code{\link{is_direct_model}()}, \code{\link{new_epidist_direct_model}()} } diff --git a/man/as_direct_model.epidist_linelist.Rd b/man/as_direct_model.epidist_linelist.Rd deleted file mode 100644 index 8102d30ac..000000000 --- a/man/as_direct_model.epidist_linelist.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/direct_model.R -\name{as_direct_model.epidist_linelist} -\alias{as_direct_model.epidist_linelist} -\title{The direct model method for \code{epidist_linelist} objects} -\usage{ -\method{as_direct_model}{epidist_linelist}(data) -} -\arguments{ -\item{data}{An \code{epidist_linelist} object} -} -\description{ -The direct model method for \code{epidist_linelist} objects -} -\seealso{ -Other direct_model: -\code{\link{as_direct_model}()}, -\code{\link{is_direct_model}()}, -\code{\link{new_epidist_direct_model}()} -} -\concept{direct_model} diff --git a/man/as_direct_model.epidist_linelist_data.Rd b/man/as_direct_model.epidist_linelist_data.Rd new file mode 100644 index 000000000..6a09524ba --- /dev/null +++ b/man/as_direct_model.epidist_linelist_data.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/direct_model.R +\name{as_direct_model.epidist_linelist_data} +\alias{as_direct_model.epidist_linelist_data} +\title{The direct model method for \code{epidist_linelist_data} objects} +\usage{ +\method{as_direct_model}{epidist_linelist_data}(data) +} +\arguments{ +\item{data}{An \code{epidist_linelist_data} object} +} +\description{ +The direct model method for \code{epidist_linelist_data} objects +} +\seealso{ +Other direct_model: +\code{\link{as_direct_model}()}, +\code{\link{is_direct_model}()}, +\code{\link{new_epidist_direct_model}()} +} +\concept{direct_model} diff --git a/man/as_epidist_linelist.Rd b/man/as_epidist_linelist.Rd deleted file mode 100644 index 4bd631131..000000000 --- a/man/as_epidist_linelist.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{as_epidist_linelist} -\alias{as_epidist_linelist} -\title{Create an epidist_linelist object} -\usage{ -as_epidist_linelist(data, ...) -} -\arguments{ -\item{data}{The data to convert} - -\item{...}{Additional arguments passed to methods} -} -\description{ -Create an epidist_linelist object -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist.data.frame}()}, -\code{\link{as_epidist_linelist.default}()}, -\code{\link{assert_epidist.epidist_linelist}()}, -\code{\link{is_epidist_linelist}()}, -\code{\link{new_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/as_epidist_linelist.data.frame.Rd b/man/as_epidist_linelist.data.frame.Rd deleted file mode 100644 index 107a17db7..000000000 --- a/man/as_epidist_linelist.data.frame.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{as_epidist_linelist.data.frame} -\alias{as_epidist_linelist.data.frame} -\title{Create an epidist_linelist object from a data frame with event dates} -\usage{ -\method{as_epidist_linelist}{data.frame}( - data, - pdate_lwr = NULL, - pdate_upr = NULL, - sdate_lwr = NULL, - sdate_upr = NULL, - obs_date = NULL, - ... -) -} -\arguments{ -\item{data}{A data.frame containing line list data} - -\item{pdate_lwr, pdate_upr, sdate_lwr, sdate_upr}{Strings giving the column of -\code{data} containing the primary and secondary event upper and lower bounds. -These columns of \code{data} must be as datetime.} - -\item{obs_date}{A string giving the column of \code{data} containing the -observation time as a datetime.} - -\item{...}{Additional arguments passed to methods} -} -\description{ -Create an epidist_linelist object from a data frame with event dates -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist}()}, -\code{\link{as_epidist_linelist.default}()}, -\code{\link{assert_epidist.epidist_linelist}()}, -\code{\link{is_epidist_linelist}()}, -\code{\link{new_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/as_epidist_linelist.default.Rd b/man/as_epidist_linelist.default.Rd deleted file mode 100644 index c8bb7f117..000000000 --- a/man/as_epidist_linelist.default.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{as_epidist_linelist.default} -\alias{as_epidist_linelist.default} -\title{Create an epidist_linelist object from vectors of event times} -\usage{ -\method{as_epidist_linelist}{default}( - data, - ptime_upr = NULL, - stime_lwr = NULL, - stime_upr = NULL, - obs_time = NULL, - ... -) -} -\arguments{ -\item{data}{Numeric vector giving lower bounds for primary times} - -\item{ptime_upr}{Numeric vector giving upper bounds for primary times} - -\item{stime_lwr, stime_upr}{Numeric vectors giving lower and upper bounds for -secondary times} - -\item{obs_time}{Numeric vector giving observation times} - -\item{...}{Additional columns to add to the epidist_linelist object} -} -\description{ -Create an epidist_linelist object from vectors of event times -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist}()}, -\code{\link{as_epidist_linelist.data.frame}()}, -\code{\link{assert_epidist.epidist_linelist}()}, -\code{\link{is_epidist_linelist}()}, -\code{\link{new_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/as_epidist_linelist_data.Rd b/man/as_epidist_linelist_data.Rd new file mode 100644 index 000000000..49822f341 --- /dev/null +++ b/man/as_epidist_linelist_data.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{as_epidist_linelist_data} +\alias{as_epidist_linelist_data} +\title{Create an epidist_linelist_data object} +\usage{ +as_epidist_linelist_data(data, ...) +} +\arguments{ +\item{data}{The data to convert} + +\item{...}{Additional arguments passed to methods} +} +\description{ +Create an epidist_linelist_data object +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data.data.frame}()}, +\code{\link{as_epidist_linelist_data.default}()}, +\code{\link{assert_epidist.epidist_linelist_data}()}, +\code{\link{is_epidist_linelist_data}()}, +\code{\link{new_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/man/as_epidist_linelist_data.data.frame.Rd b/man/as_epidist_linelist_data.data.frame.Rd new file mode 100644 index 000000000..480007340 --- /dev/null +++ b/man/as_epidist_linelist_data.data.frame.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{as_epidist_linelist_data.data.frame} +\alias{as_epidist_linelist_data.data.frame} +\title{Create an epidist_linelist_data object from a data frame with event dates} +\usage{ +\method{as_epidist_linelist_data}{data.frame}( + data, + pdate_lwr = NULL, + sdate_lwr = NULL, + pdate_upr = NULL, + sdate_upr = NULL, + obs_date = NULL, + ... +) +} +\arguments{ +\item{data}{A data.frame containing line list data} + +\item{pdate_lwr}{A string giving the column of \code{data} containing the primary +event lower bound as a datetime. Defaults to \code{NULL} which assumes that the +variable \code{pdate_lwr} is present.} + +\item{sdate_lwr}{A string giving the column of \code{data} containing the +secondary event lower bound as a datetime. Defaults to \code{NULL} which assumes +that the variable \code{sdate_lwr} is present.} + +\item{pdate_upr}{A string giving the column of \code{data} containing the primary +event upper bound as a datetime. If this column exists in the data it will be +used, otherwise if not supplied then the value of \code{pdate_lwr} + 1 day is +used.} + +\item{sdate_upr}{A string giving the column of \code{data} containing the +secondary event upper bound as a datetime. If this column exists in the data +it will be used, otherwise if not supplied then the value of \code{sdate_lwr} + 1 +day is used.} + +\item{obs_date}{A string giving the column of \code{data} containing the +observation time as a datetime. Optional, if not supplied then the maximum of +\code{sdate_upr} is used.} + +\item{...}{Additional arguments passed to methods} +} +\description{ +Create an epidist_linelist_data object from a data frame with event dates +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data}()}, +\code{\link{as_epidist_linelist_data.default}()}, +\code{\link{assert_epidist.epidist_linelist_data}()}, +\code{\link{is_epidist_linelist_data}()}, +\code{\link{new_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/man/as_epidist_linelist_data.default.Rd b/man/as_epidist_linelist_data.default.Rd new file mode 100644 index 000000000..5ae558a03 --- /dev/null +++ b/man/as_epidist_linelist_data.default.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{as_epidist_linelist_data.default} +\alias{as_epidist_linelist_data.default} +\title{Create an epidist_linelist_data object from vectors of event times} +\usage{ +\method{as_epidist_linelist_data}{default}( + data, + ptime_upr = NULL, + stime_lwr = NULL, + stime_upr = NULL, + obs_time = NULL, + ... +) +} +\arguments{ +\item{data}{Numeric vector giving lower bounds for primary times} + +\item{ptime_upr}{Numeric vector giving upper bounds for primary times} + +\item{stime_lwr, stime_upr}{Numeric vectors giving lower and upper bounds for +secondary times} + +\item{obs_time}{Numeric vector giving observation times} + +\item{...}{Additional columns to add to the epidist_linelist_data object} +} +\description{ +Create an epidist_linelist_data object from vectors of event times +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data}()}, +\code{\link{as_epidist_linelist_data.data.frame}()}, +\code{\link{assert_epidist.epidist_linelist_data}()}, +\code{\link{is_epidist_linelist_data}()}, +\code{\link{new_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/man/assert_epidist.epidist_linelist.Rd b/man/assert_epidist.epidist_linelist.Rd deleted file mode 100644 index 5d6f715fd..000000000 --- a/man/assert_epidist.epidist_linelist.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{assert_epidist.epidist_linelist} -\alias{assert_epidist.epidist_linelist} -\title{Assert validity of \code{epidist_linelist} objects} -\usage{ -\method{assert_epidist}{epidist_linelist}(data, ...) -} -\description{ -Assert validity of \code{epidist_linelist} objects -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist}()}, -\code{\link{as_epidist_linelist.data.frame}()}, -\code{\link{as_epidist_linelist.default}()}, -\code{\link{is_epidist_linelist}()}, -\code{\link{new_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/assert_epidist.epidist_linelist_data.Rd b/man/assert_epidist.epidist_linelist_data.Rd new file mode 100644 index 000000000..650b7e52a --- /dev/null +++ b/man/assert_epidist.epidist_linelist_data.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{assert_epidist.epidist_linelist_data} +\alias{assert_epidist.epidist_linelist_data} +\title{Assert validity of \code{epidist_linelist_data} objects} +\usage{ +\method{assert_epidist}{epidist_linelist_data}(data, ...) +} +\description{ +Assert validity of \code{epidist_linelist_data} objects +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data}()}, +\code{\link{as_epidist_linelist_data.data.frame}()}, +\code{\link{as_epidist_linelist_data.default}()}, +\code{\link{is_epidist_linelist_data}()}, +\code{\link{new_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/man/is_direct_model.Rd b/man/is_direct_model.Rd index 4cca290d7..cb79b0021 100644 --- a/man/is_direct_model.Rd +++ b/man/is_direct_model.Rd @@ -15,7 +15,7 @@ Check if data has the \code{epidist_direct_model} class \seealso{ Other direct_model: \code{\link{as_direct_model}()}, -\code{\link{as_direct_model.epidist_linelist}()}, +\code{\link{as_direct_model.epidist_linelist_data}()}, \code{\link{new_epidist_direct_model}()} } \concept{direct_model} diff --git a/man/is_epidist_linelist.Rd b/man/is_epidist_linelist.Rd deleted file mode 100644 index 8f258a22f..000000000 --- a/man/is_epidist_linelist.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{is_epidist_linelist} -\alias{is_epidist_linelist} -\title{Check if data has the \code{epidist_linelist} class} -\usage{ -is_epidist_linelist(data, ...) -} -\arguments{ -\item{data}{The data to convert} - -\item{...}{Additional arguments} -} -\description{ -Check if data has the \code{epidist_linelist} class -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist}()}, -\code{\link{as_epidist_linelist.data.frame}()}, -\code{\link{as_epidist_linelist.default}()}, -\code{\link{assert_epidist.epidist_linelist}()}, -\code{\link{new_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/is_epidist_linelist_data.Rd b/man/is_epidist_linelist_data.Rd new file mode 100644 index 000000000..2a193a81d --- /dev/null +++ b/man/is_epidist_linelist_data.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{is_epidist_linelist_data} +\alias{is_epidist_linelist_data} +\title{Check if data has the \code{epidist_linelist_data} class} +\usage{ +is_epidist_linelist_data(data, ...) +} +\arguments{ +\item{data}{The data to convert} + +\item{...}{Additional arguments} +} +\description{ +Check if data has the \code{epidist_linelist_data} class +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data}()}, +\code{\link{as_epidist_linelist_data.data.frame}()}, +\code{\link{as_epidist_linelist_data.default}()}, +\code{\link{assert_epidist.epidist_linelist_data}()}, +\code{\link{new_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/man/new_epidist_direct_model.Rd b/man/new_epidist_direct_model.Rd index ab702b403..0d72387d1 100644 --- a/man/new_epidist_direct_model.Rd +++ b/man/new_epidist_direct_model.Rd @@ -18,7 +18,7 @@ Class constructor for \code{epidist_direct_model} objects \seealso{ Other direct_model: \code{\link{as_direct_model}()}, -\code{\link{as_direct_model.epidist_linelist}()}, +\code{\link{as_direct_model.epidist_linelist_data}()}, \code{\link{is_direct_model}()} } \concept{direct_model} diff --git a/man/new_epidist_linelist.Rd b/man/new_epidist_linelist.Rd deleted file mode 100644 index e3b44e5a4..000000000 --- a/man/new_epidist_linelist.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidist_linelist.R -\name{new_epidist_linelist} -\alias{new_epidist_linelist} -\title{Class constructor for \code{epidist_linelist} objects} -\usage{ -new_epidist_linelist(data) -} -\arguments{ -\item{data}{A data.frame to convert} -} -\value{ -An object of class \code{epidist_linelist} -} -\description{ -Class constructor for \code{epidist_linelist} objects -} -\seealso{ -Other linelist: -\code{\link{as_epidist_linelist}()}, -\code{\link{as_epidist_linelist.data.frame}()}, -\code{\link{as_epidist_linelist.default}()}, -\code{\link{assert_epidist.epidist_linelist}()}, -\code{\link{is_epidist_linelist}()} -} -\concept{linelist} diff --git a/man/new_epidist_linelist_data.Rd b/man/new_epidist_linelist_data.Rd new file mode 100644 index 000000000..166fb9590 --- /dev/null +++ b/man/new_epidist_linelist_data.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linelist_data.R +\name{new_epidist_linelist_data} +\alias{new_epidist_linelist_data} +\title{Class constructor for \code{epidist_linelist_data} objects} +\usage{ +new_epidist_linelist_data(data) +} +\arguments{ +\item{data}{A data.frame to convert} +} +\value{ +An object of class \code{epidist_linelist_data} +} +\description{ +Class constructor for \code{epidist_linelist_data} objects +} +\seealso{ +Other linelist_data: +\code{\link{as_epidist_linelist_data}()}, +\code{\link{as_epidist_linelist_data.data.frame}()}, +\code{\link{as_epidist_linelist_data.default}()}, +\code{\link{assert_epidist.epidist_linelist_data}()}, +\code{\link{is_epidist_linelist_data}()} +} +\concept{linelist_data} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index b7eb65218..7f6e7d160 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -19,7 +19,7 @@ sim_obs <- simulate_gillespie() |> dplyr::slice_sample(n = sample_size, replace = FALSE) # Temporary solution for classing time data -sim_obs <- as_epidist_linelist( +sim_obs <- as_epidist_linelist_data( sim_obs$ptime_lwr, sim_obs$ptime_upr, sim_obs$stime_lwr, @@ -46,7 +46,7 @@ sim_obs_gamma <- simulate_gillespie() |> dplyr::slice_sample(n = sample_size, replace = FALSE) # Temporary solution for classing time data -sim_obs_gamma <- as_epidist_linelist( +sim_obs_gamma <- as_epidist_linelist_data( sim_obs_gamma$ptime_lwr, sim_obs_gamma$ptime_upr, sim_obs_gamma$stime_lwr, @@ -87,7 +87,7 @@ sim_obs_sex <- dplyr::bind_rows(sim_obs_sex_m, sim_obs_sex_f) |> dplyr::slice_sample(n = sample_size, replace = FALSE) # Temporary solution for classing time data -sim_obs_sex <- as_epidist_linelist( +sim_obs_sex <- as_epidist_linelist_data( sim_obs_sex$ptime_lwr, sim_obs_sex$ptime_upr, sim_obs_sex$stime_lwr, diff --git a/tests/testthat/test-latent_individual.R b/tests/testthat/test-latent_individual.R index f0c0412c4..51770d1b3 100644 --- a/tests/testthat/test-latent_individual.R +++ b/tests/testthat/test-latent_individual.R @@ -1,10 +1,10 @@ -test_that("as_latent_individual.epidist_linelist with default settings an object with the correct classes", { # nolint: line_length_linter. +test_that("as_latent_individual.epidist_linelist_data with default settings an object with the correct classes", { # nolint: line_length_linter. prep_obs <- as_latent_individual(sim_obs) expect_s3_class(prep_obs, "data.frame") expect_s3_class(prep_obs, "epidist_latent_individual") }) -test_that("as_latent_individual.epidist_linelist errors when passed incorrect inputs", { # nolint: line_length_linter. +test_that("as_latent_individual.epidist_linelist_data errors when passed incorrect inputs", { # nolint: line_length_linter. expect_error(as_latent_individual(list())) expect_error(as_latent_individual(sim_obs[, 1])) }) diff --git a/tests/testthat/test-preprocess.R b/tests/testthat/test-linelist_data.R similarity index 70% rename from tests/testthat/test-preprocess.R rename to tests/testthat/test-linelist_data.R index 5d29e08c3..5c160369a 100644 --- a/tests/testthat/test-preprocess.R +++ b/tests/testthat/test-linelist_data.R @@ -1,4 +1,4 @@ -test_that("as_epidist_linelist assigns epidist_linelist class to data", { +test_that("as_epidist_linelist_data assigns epidist_linelist_data class to data", { data <- data.frame( case = 1, pdate_lwr = as.POSIXct("2023-01-01 00:00:00"), @@ -7,13 +7,13 @@ test_that("as_epidist_linelist assigns epidist_linelist class to data", { sdate_upr = as.POSIXct("2023-01-04 00:00:00"), obs_date = as.POSIXct("2023-01-05 00:00:00") ) - linelist <- as_epidist_linelist( + linelist_data <- as_epidist_linelist_data( data, "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" ) - expect_s3_class(linelist, "epidist_linelist") + expect_s3_class(linelist_data, "epidist_linelist_data") }) -test_that("as_epidist_linelist correctly renames columns", { +test_that("as_epidist_linelist_data correctly renames columns", { data <- data.frame( case = 1, p_lower = as.POSIXct("2023-01-01"), @@ -22,14 +22,14 @@ test_that("as_epidist_linelist correctly renames columns", { s_upper = as.POSIXct("2023-01-04"), observation = as.POSIXct("2023-01-05") ) - linelist <- as_epidist_linelist( + linelist_data <- as_epidist_linelist_data( data, "p_lower", "p_upper", "s_lower", "s_upper", "observation" ) col_names <- c("pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date") - expect_true(all(col_names %in% names(linelist))) + expect_true(all(col_names %in% names(linelist_data))) }) -test_that("as_epidist_linelist gives error if columns are not datetime", { +test_that("as_epidist_linelist_data gives error if columns are not datetime", { data <- data.frame( case = 1, pdate_lwr = as.Date("2023-01-01"), @@ -39,7 +39,7 @@ test_that("as_epidist_linelist gives error if columns are not datetime", { obs_date = as.Date("2023-01-05") ) expect_error( - as_epidist_linelist( + as_epidist_linelist_data( data, "pdate_lwr", "pdate_upr", "sdate_lwr", "sdate_upr", "obs_date" ) ) diff --git a/vignettes/approx-inference.Rmd b/vignettes/approx-inference.Rmd index 800886476..db1da34c9 100644 --- a/vignettes/approx-inference.Rmd +++ b/vignettes/approx-inference.Rmd @@ -130,7 +130,7 @@ obs_cens_trunc_samp <- simulate_gillespie(seed = 101) |> We now prepare the data for fitting with the latent individual model, and perform inference with HMC: ```{r results='hide'} -linelist <- as_epidist_linelist( +linelist_data <- as_epidist_linelist_data( obs_cens_trunc_samp$ptime_lwr, obs_cens_trunc_samp$ptime_upr, obs_cens_trunc_samp$stime_lwr, @@ -138,7 +138,7 @@ linelist <- as_epidist_linelist( obs_time = obs_cens_trunc_samp$obs_time ) -data <- as_latent_individual(linelist) +data <- as_latent_individual(linelist_data) t <- proc.time() fit_hmc <- epidist(data = data, algorithm = "sampling", backend = "cmdstanr") diff --git a/vignettes/ebola.Rmd b/vignettes/ebola.Rmd index fc40ad0fc..61e172e60 100644 --- a/vignettes/ebola.Rmd +++ b/vignettes/ebola.Rmd @@ -45,6 +45,7 @@ set.seed(123) library(epidist) library(brms) +library(tibble) library(dplyr) library(purrr) library(ggplot2) @@ -163,29 +164,18 @@ That is, $\mu$ and $\sigma$ such that when $x \sim \mathcal{N}(\mu, \sigma)$ the ## Data preparation -To prepare the data, we begin by transforming the date columns to `ptime` and `stime` columns for the times of the primary and secondary events respectively. -Both of these columns are relative to the first date of symptom onset in the data: +To prepare the data, we begin by filtering for the relevant columns and converting the date columns to `Date` objects: ```{r} -sierra_leone_ebola_data <- sierra_leone_ebola_data |> +obs_cens <- sierra_leone_ebola_data |> + tibble() |> mutate( # use lubridate::ymd() to drop any sub-date time info date_of_symptom_onset = ymd(date_of_symptom_onset), date_of_sample_tested = ymd(date_of_sample_tested), - # ptime and stime represent the number of days elapsed since the earliest - # date of symptom onset in the data - ptime = as.numeric(date_of_symptom_onset - min(date_of_symptom_onset)), - stime = as.numeric(date_of_sample_tested - min(date_of_symptom_onset)) ) |> - select(case, ptime, stime, age, sex, district) - -head(sierra_leone_ebola_data) -``` + select(case, date_of_symptom_onset, date_of_sample_tested, age, sex, district) -Next, we use `observe_process()` to add interval censoring columns giving the lower and upper bounds on the primary and secondary event times: - -```{r} -obs_cens <- observe_process(sierra_leone_ebola_data) head(obs_cens) ``` @@ -211,20 +201,24 @@ obs_cens <- obs_cens |> slice_sample(n = round(n_complete * subsample), replace = FALSE) ``` -## Model fitting - -To prepare the data for use with the latent individual model, we set `obs_cens` to be an `epidist_linelist` object, then use the function `as_latent_individual()`: +Finally, we prepare the data for use with the `epidist` package by converting the data to an `epidist_linelist_data` object: ```{r} -linelist <- as_epidist_linelist( - obs_cens$ptime_lwr, - obs_cens$ptime_upr, - obs_cens$stime_lwr, - obs_cens$stime_upr, - obs_time = obs_cens$obs_time -) +linelist_data <- obs_cens |> + as_epidist_linelist_data( + pdate_lwr = "date_of_symptom_onset", + sdate_lwr = "date_of_sample_tested" + ) +``` + +Note that this has made some assumptions about the data in that it has assumed that as we did not supply upper bounds for the primary and secondary events, that the upper bounds are one day after the lower bounds. It has also assumed that the observation time is the maximum of the secondary event upper bound as we also did not supply an observation time column. + +## Model fitting + +To prepare the data for use with the latent individual model, we define the data as being a `latent_individual` model object: -obs_prep <- as_latent_individual(linelist) +```{r +obs_prep <- as_latent_individual(linelist_data) head(obs_prep) ``` diff --git a/vignettes/epidist.Rmd b/vignettes/epidist.Rmd index 217d5295c..57efd1fca 100644 --- a/vignettes/epidist.Rmd +++ b/vignettes/epidist.Rmd @@ -247,7 +247,7 @@ We will fit the model `"latent_individual"` which uses latent variables for the To do so, we first prepare the `data` using `as_latent_individual()`: ```{r} -linelist <- as_epidist_linelist( +linelist_data <- as_epidist_linelist_data( obs_cens_trunc_samp$ptime_lwr, obs_cens_trunc_samp$ptime_upr, obs_cens_trunc_samp$stime_lwr, @@ -255,7 +255,7 @@ linelist <- as_epidist_linelist( obs_time = obs_cens_trunc_samp$obs_time ) -data <- as_latent_individual(linelist) +data <- as_latent_individual(linelist_data) class(data) ``` diff --git a/vignettes/faq.Rmd b/vignettes/faq.Rmd index 56770d890..2ceca4501 100644 --- a/vignettes/faq.Rmd +++ b/vignettes/faq.Rmd @@ -47,14 +47,14 @@ obs_cens_trunc_samp <- simulate_gillespie(seed = 101) |> filter(.data$stime_upr <= obs_time) |> slice_sample(n = sample_size, replace = FALSE) -linelist <- as_epidist_linelist( +linelist_data <- as_epidist_linelist_data( obs_cens_trunc_samp$ptime_lwr, obs_cens_trunc_samp$ptime_upr, obs_cens_trunc_samp$stime_lwr, obs_cens_trunc_samp$stime_upr, obs_time = obs_cens_trunc_samp$obs_time ) -data <- as_latent_individual(linelist) +data <- as_latent_individual(linelist_data) fit <- epidist( data,