inst/doc/usage.R

In pmrm: Progression Models for Repeated Measures

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7L,
  fig.height = 5L
)

## -----------------------------------------------------------------------------
library(pmrm)
set.seed(0)
simulation <- pmrm_simulate_decline_proportional(
  patients = 500,
  visit_times = c(0, 1, 2, 3, 4),
  tau = 0.25,
  alpha = c(0, 0.7, 1, 1.4, 1.6),
  beta = c(0, 0.2, 0.35),
  gamma = c(-1, 1)
)

## -----------------------------------------------------------------------------
simulation$y[c(2L, 3L, 12L, 13L, 14L, 15L)] <- NA_real_

## -----------------------------------------------------------------------------
simulation[, c("y", "t", "patient", "visit", "arm")]

## -----------------------------------------------------------------------------
system.time(
  fit <- pmrm_model_decline_proportional(
    data = simulation,
    outcome = "y",
    time = "t",
    patient = "patient",
    visit = "visit",
    arm = "arm",
    covariates = ~ w_1 + w_2,
    visit_times = c(0, 1, 2, 3, 4)
  )
)

## -----------------------------------------------------------------------------
print(fit)

## -----------------------------------------------------------------------------
names(fit)

## -----------------------------------------------------------------------------
str(fit$estimates)

## -----------------------------------------------------------------------------
str(fit$final)

## -----------------------------------------------------------------------------
fit$optimization$convergence

## -----------------------------------------------------------------------------
str(fit$estimates)

## -----------------------------------------------------------------------------
str(fit$standard_errors)

## -----------------------------------------------------------------------------
knots <- fit$constants$spline_knots
curve(fit$spline(x), min(knots), max(knots))

## -----------------------------------------------------------------------------
initial <- fit$initial
initial$alpha <- c(0, 0.5, 1, 1.5, 2)

fit2 <- pmrm_model_decline_proportional(
  data = simulation,
  outcome = "y",
  time = "t",
  patient = "patient",
  visit = "visit",
  arm = "arm",
  covariates = ~ w_1 + w_2,
  visit_times = c(0, 1, 2, 3, 4),
  initial = initial # with hand-picked initial alpha
)

## -----------------------------------------------------------------------------
initial <- fit$final # true parameters from the last fit
initial$theta[2] <- 0 # reset a scalar parameter that may have diverged

fit3 <- pmrm_model_decline_proportional(
  data = simulation,
  outcome = "y",
  time = "t",
  patient = "patient",
  visit = "visit",
  arm = "arm",
  covariates = ~ w_1 + w_2,
  visit_times = c(0, 1, 2, 3, 4),
  initial = initial # with the modified parameter values
)

## ----eval = FALSE-------------------------------------------------------------
# library(dplyr)
# library(tmbstan)
# library(posterior)
# 
# # Fit a Bayesian version of the same model.
# # Increase the number of chains for the Rhat diagnostic to be valid.
# mcmc <- tmbstan(fit$model, chains = 1, refresh = 10)
# 
# # Extract the MCMC draws.
# draws <- as_draws_df(mcmc) |>
#   select(starts_with("alpha"), any_of(c("theta", "phi")))
# 
# # Plot pairwise correlations among MCMC draws.
# # Pairs of parameters should not be strongly correlated.
# # Tight correlations and funneling indicate problems,
# # such as non-identifiability if you have too many knots.
# pairs(draws)
# 
# # Alternatively, if you have many parameters, you can look at
# # pairwise linear correlations. However, this may miss
# # important pathologies.
# correlations <- cor(samples)[lower.tri(cor(samples))]
# hist(correlations)

## -----------------------------------------------------------------------------
pmrm_estimates(fit, parameter = "theta")

## -----------------------------------------------------------------------------
pmrm_estimates(fit, parameter = "sigma", confidence = 0.9)

## -----------------------------------------------------------------------------
summary(fit)

## -----------------------------------------------------------------------------
pmrm_marginals(fit, type = "outcome")

## -----------------------------------------------------------------------------
pmrm_marginals(fit, type = "change")

## -----------------------------------------------------------------------------
pmrm_marginals(fit, type = "effect")

## -----------------------------------------------------------------------------
predict(fit, data = head(simulation, 5))

## -----------------------------------------------------------------------------
plot(
  fit,
  show_predictions = TRUE # Defaults to FALSE because predictions take extra time.
)

## -----------------------------------------------------------------------------
plot(
  fit,
  confidence = 0.9,
  show_data = FALSE,
  show_predictions = TRUE, # Defaults to FALSE because predictions take extra time.
  facet = FALSE,
  alpha = 0.5
)