Merge pull request #47 from generable/develop

v0.2.11

Author: jtimonen

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",

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)) {

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)
     },
 

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() {

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

man/MultiStateModel.Rd

@@ -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("")
 ```