diff --git a/DESCRIPTION b/DESCRIPTION index 88ac4c8..5119800 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: bmstate Type: Package Title: Bayesian multistate modeling -Version: 0.2.10 +Version: 0.2.11 Authors@R: c(person(given = "Juho", family = "Timonen", diff --git a/R/DosingData.R b/R/DosingData.R index 3c2ef1b..259ac68 100644 --- a/R/DosingData.R +++ b/R/DosingData.R @@ -92,6 +92,9 @@ PSSDosingData <- R6::R6Class( subject_id = sid, dose_ss = dose_ss, dose = doses, time = times ) + which_missed <- which(rows$dose == 0) + rows$dose_time <- "Taken" + rows$dose_time[which_missed] <- "Missed" out <- rbind(out, rows) } out @@ -167,8 +170,12 @@ PSSDosingData <- R6::R6Class( )) + facet_wrap(. ~ .data$subject_id, scales = "free_x") + geom_vline( - data = dos, mapping = aes(xintercept = time), - col = "firebrick", lty = 2 + data = dos, mapping = aes(xintercept = time, lty = .data$dose_time), + col = "firebrick" + ) + + scale_linetype_manual( + values = + c(3, 1), name = "Dose" ) if (!is.null(df_fit)) { if (!is.null(df_fit$lower)) { diff --git a/R/MultistateModel.R b/R/MultistateModel.R index 632e933..0d308f6 100644 --- a/R/MultistateModel.R +++ b/R/MultistateModel.R @@ -399,13 +399,15 @@ MultistateModel <- R6::R6Class("MultistateModel", #' @param w Spline weights. Matrix of shape \code{num_trans} x #' \code{num_weights}. If \code{NULL}, a matrix of zeros is used. #' @param num_doses Average number of doses taken by each subject. Only - #' has effect if model as a PK submodel. + #' has effect if model has a PK submodel. #' @param subjects_df Subject data frame. If \code{NULL}, simulated using #' the \code{simulate_subjects} method. + #' @param truncate Truncate paths after terminal events? #' @return A \code{\link{JointData}} object. simulate_data = function(N_subject = 100, beta_haz = NULL, beta_pk = NULL, w0 = 1e-3, w = NULL, num_doses = 10, - subjects_df = NULL) { + subjects_df = NULL, truncate = TRUE) { + checkmate::assert_logical(truncate, len = 1) H <- self$system$num_trans() if (is.null(subjects_df)) { subjects_df <- self$simulate_subjects(N_subject) @@ -442,6 +444,9 @@ MultistateModel <- R6::R6Class("MultistateModel", subjects_df, path_df, link_df, self$system$tm(), colnames(subjects_df) ) + if (truncate) { + pd <- pd$truncate() + } JointData$new(pd, pksim$dosing) }, diff --git a/R/PathData.R b/R/PathData.R index 428ac83..36d52e5 100644 --- a/R/PathData.R +++ b/R/PathData.R @@ -106,6 +106,14 @@ PathData <- R6::R6Class( unique(self$subject_df$subject_id) }, + #' @description Truncate paths after terminal events + #' @return A new \code{\link{PathData}} object with only the paths data + #' frame edited. + truncate = function() { + pdf <- self$get_path_df(truncate = TRUE) + PathData$new(self$subject_df, pdf, self$link_df, self$transmat, self$covs) + }, + #' @description Get names of covariates #' @return a character vector covariate_names = function() { diff --git a/R/utils.R b/R/utils.R index 7210e14..4bbd93d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,7 +4,9 @@ pksim_to_quantiles <- function(sim, ci_alpha) { av <- (1 - ci_alpha) / 2 sim <- sim |> dplyr::group_by(.data$subject_id, .data$time) |> - dplyr::summarise(q = list(quantile(.data$val, probs = c(av / 2, 0.5, 1 - av / 2))), .groups = "drop") |> + dplyr::summarise(q = list( + stats::quantile(.data$val, probs = c(av / 2, 0.5, 1 - av / 2)) + ), .groups = "drop") |> tidyr::unnest_wider(q, names_sep = "_") colnames(sim)[3:5] <- c("lower", "val", "upper") sim diff --git a/man/MultiStateModel.Rd b/man/MultiStateModel.Rd index 0a2b4ae..20d42c0 100644 --- a/man/MultiStateModel.Rd +++ b/man/MultiStateModel.Rd @@ -370,7 +370,8 @@ Simulate data using the multistate model w0 = 0.001, w = NULL, num_doses = 10, - subjects_df = NULL + subjects_df = NULL, + truncate = TRUE )}\if{html}{\out{}} } @@ -393,10 +394,12 @@ a vector of zeros is used.} \code{num_weights}. If \code{NULL}, a matrix of zeros is used.} \item{\code{num_doses}}{Average number of doses taken by each subject. Only -has effect if model as a PK submodel.} +has effect if model has a PK submodel.} \item{\code{subjects_df}}{Subject data frame. If \code{NULL}, simulated using the \code{simulate_subjects} method.} + +\item{\code{truncate}}{Truncate paths after terminal events?} } \if{html}{\out{}} } diff --git a/man/PathData.Rd b/man/PathData.Rd index c2f8dfd..b725222 100644 --- a/man/PathData.Rd +++ b/man/PathData.Rd @@ -46,6 +46,7 @@ which the paths belong.} \itemize{ \item \href{#method-PathData-new}{\code{PathData$new()}} \item \href{#method-PathData-unique_subjects}{\code{PathData$unique_subjects()}} +\item \href{#method-PathData-truncate}{\code{PathData$truncate()}} \item \href{#method-PathData-covariate_names}{\code{PathData$covariate_names()}} \item \href{#method-PathData-subset_covariates}{\code{PathData$subset_covariates()}} \item \href{#method-PathData-state_at}{\code{PathData$state_at()}} @@ -120,6 +121,20 @@ Get unique subject ids \if{html}{\out{
}}\preformatted{PathData$unique_subjects()}\if{html}{\out{
}} } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PathData-truncate}{}}} +\subsection{Method \code{truncate()}}{ +Truncate paths after terminal events +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PathData$truncate()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A new \code{\link{PathData}} object with only the paths data +frame edited. +} } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/vignettes/math.Rmd b/vignettes/math.Rmd index bf3cdb2..1704e82 100644 --- a/vignettes/math.Rmd +++ b/vignettes/math.Rmd @@ -150,7 +150,7 @@ set.seed(2344) mod <- create_msm(tmat, n_grid = 12) # set very low n_grid for demo h0_true <- rep(1e-3, 3) mod$set_prior_mean_h0(h0_true) # has no effect for simulation -dat <- mod$simulate_data(N_subject = 1, w0 = h0_true) +dat <- mod$simulate_data(N_subject = 1, w0 = h0_true, truncate = FALSE) dat$paths$plot_paths(truncate = TRUE, alpha = 1) + ggtitle("") ```