Merge pull request #116 from openpharma/113

Allow factors

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: brms.mmrm
 Title: Bayesian MMRMs using 'brms'
-Version: 1.0.1.9002
+Version: 1.0.1.9003
 Authors@R: c(
   person(
     given = c("William", "Michael"),

NAMESPACE

@@ -82,7 +82,9 @@ importFrom(purrr,map_dbl)
 importFrom(purrr,map_df)
 importFrom(rlang,is_formula)
 importFrom(rlang,warn)
+importFrom(stats,"contrasts<-")
 importFrom(stats,as.formula)
+importFrom(stats,contr.treatment)
 importFrom(stats,median)
 importFrom(stats,model.matrix)
 importFrom(stats,rbinom)

NEWS.md

@@ -1,8 +1,9 @@
-# brms.mmrm 1.0.1.9002 (development)
+# brms.mmrm 1.0.1.9003 (development)
 
 * Add `brm_marginal_grid()`.
 * Show posterior samples of `sigma` in `brm_marginal_draws()` and `brm_marginal_summaries()`.
 * Allow `outcome = "response"` with `reference_time = NULL`. Sometimes raw response is analyzed but the data has no baseline time point.
+* Preserve factors in `brm_data()` and encourage ordered factors for the time variable (#113). 
 
 # brms.mmrm 1.0.1
 

R/brm_archetype.R

@@ -113,9 +113,13 @@ brm_data_validate.brms_mmrm_archetype <- function(data) {
     !anyDuplicated(mapping$variable),
     message = "mapping$variable must have all unique values"
   )
-  groups <- attr(data, "brm_levels_group")
-  subgroups <- attr(data, "brm_levels_subgroup")
-  times <- attr(data, "brm_levels_time")
+  groups <- brm_levels(data[[attr(data, "brm_group")]])
+  subgroups <- if_any(
+    is.null(attr(data, "brm_subgroup")),
+    character(0L),
+    brm_levels(data[[attr(data, "brm_subgroup")]])
+  )
+  times <-  brm_levels(data[[attr(data, "brm_time")]])
   n_group <- length(groups)
   n_subgroup <- length(subgroups)
   n_time <- length(times)

R/brm_archetype_average_cells.R

@@ -174,8 +174,8 @@ brm_archetype_average_cells <- function(
 archetype_average_cells <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[attr(data, "brm_group")]])
+  levels_time <- brm_levels(data[[attr(data, "brm_time")]])
   n_time <- length(levels_time)
   matrix <- NULL
   for (name_group in levels_group) {
@@ -194,7 +194,6 @@ archetype_average_cells <- function(data, prefix) {
   names_group <- rep(levels_group, each = n_time)
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -209,9 +208,9 @@ archetype_average_cells_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
   n_time <- length(levels_time)
@@ -243,7 +242,6 @@ archetype_average_cells_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(

R/brm_archetype_average_effects.R

@@ -178,8 +178,8 @@ brm_archetype_average_effects <- function(
 archetype_average_effects <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   n_time <- length(levels_time)
   matrix <- NULL
@@ -203,7 +203,6 @@ archetype_average_effects <- function(data, prefix) {
   names_group <- rep(levels_group, each = n_time)
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -218,9 +217,9 @@ archetype_average_effects_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
@@ -258,7 +257,6 @@ archetype_average_effects_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(

R/brm_archetype_cells.R

@@ -146,8 +146,8 @@ brm_archetype_cells <- function(
 archetype_cells <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_time <- brm_levels(data[[time]])
   matrix <- NULL
   for (name_group in levels_group) {
     for (name_time in levels_time) {
@@ -158,7 +158,6 @@ archetype_cells <- function(data, prefix) {
   names_group <- rep(levels_group, each = length(levels_time))
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -173,9 +172,9 @@ archetype_cells_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
   n_time <- length(levels_time)
@@ -197,7 +196,6 @@ archetype_cells_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(

R/brm_archetype_effects.R

@@ -171,8 +171,8 @@ brm_archetype_effects <- function(
 archetype_effects <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   matrix <- NULL
   for (name_group in levels_group) {
@@ -188,7 +188,6 @@ archetype_effects <- function(data, prefix) {
   names_group <- rep(levels_group, each = length(levels_time))
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -203,9 +202,9 @@ archetype_effects_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
@@ -233,7 +232,6 @@ archetype_effects_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(

R/brm_archetype_successive_cells.R

@@ -189,10 +189,10 @@ brm_archetype_successive_cells <- function(
 archetype_successive_cells <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_time <- brm_levels(data[[time]])
   n_time <- length(levels_time)
-  data_first <- data[data[[time]] == data[[time]][1L], ]
+  data_first <- data[data[[time]] == levels_time[1L], ]
   matrix_group <- NULL
   for (name in levels_group) {
     matrix_group <- cbind(
@@ -205,7 +205,6 @@ archetype_successive_cells <- function(data, prefix) {
   names_group <- rep(levels_group, each = n_time)
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -220,9 +219,9 @@ archetype_successive_cells_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
   n_time <- length(levels_time)
@@ -244,7 +243,6 @@ archetype_successive_cells_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(

R/brm_archetype_successive_effects.R

@@ -179,8 +179,8 @@ brm_archetype_successive_effects <- function(
 archetype_successive_effects <- function(data, prefix) {
   group <- attr(data, "brm_group")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   n_time <- length(levels_time)
   data_first <- data[data[[time]] == data[[time]][1L], ]
@@ -198,7 +198,6 @@ archetype_successive_effects <- function(data, prefix) {
   names_group <- rep(levels_group, each = n_time)
   names_time <- rep(levels_time, times = length(levels_group))
   names <- paste0(prefix, paste(names_group, names_time, sep = "_"))
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(
@@ -213,9 +212,9 @@ archetype_successive_effects_subgroup <- function(data, prefix) {
   group <- attr(data, "brm_group")
   subgroup <- attr(data, "brm_subgroup")
   time <- attr(data, "brm_time")
-  levels_group <- attr(data, "brm_levels_group")
-  levels_subgroup <- attr(data, "brm_levels_subgroup")
-  levels_time <- attr(data, "brm_levels_time")
+  levels_group <- brm_levels(data[[group]])
+  levels_subgroup <- brm_levels(data[[subgroup]])
+  levels_time <- brm_levels(data[[time]])
   reference <- attr(data, "brm_reference_group")
   n_group <- length(levels_group)
   n_subgroup <- length(levels_subgroup)
@@ -242,7 +241,6 @@ archetype_successive_effects_subgroup <- function(data, prefix) {
     prefix,
     paste(names_group, names_subgroup, names_time, sep = "_")
   )
-  names <- brm_levels(names)
   colnames(matrix) <- names
   interest <- tibble::as_tibble(as.data.frame(matrix))
   mapping <- tibble::tibble(