diff --git a/R/brm_archetype_average_cells.R b/R/brm_archetype_average_cells.R index 63a189fb..edb789ad 100644 --- a/R/brm_archetype_average_cells.R +++ b/R/brm_archetype_average_cells.R @@ -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( @@ -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( diff --git a/R/brm_archetype_average_effects.R b/R/brm_archetype_average_effects.R index 202524d1..68db0043 100644 --- a/R/brm_archetype_average_effects.R +++ b/R/brm_archetype_average_effects.R @@ -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( @@ -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( diff --git a/R/brm_archetype_cells.R b/R/brm_archetype_cells.R index bf537252..839ddbb0 100644 --- a/R/brm_archetype_cells.R +++ b/R/brm_archetype_cells.R @@ -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( @@ -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( diff --git a/R/brm_archetype_effects.R b/R/brm_archetype_effects.R index 91df2bb4..c746c38b 100644 --- a/R/brm_archetype_effects.R +++ b/R/brm_archetype_effects.R @@ -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( @@ -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( diff --git a/R/brm_archetype_successive_cells.R b/R/brm_archetype_successive_cells.R index 00af39c0..16e52a0a 100644 --- a/R/brm_archetype_successive_cells.R +++ b/R/brm_archetype_successive_cells.R @@ -192,7 +192,7 @@ archetype_successive_cells <- function(data, prefix) { 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( @@ -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( diff --git a/R/brm_archetype_successive_effects.R b/R/brm_archetype_successive_effects.R index 3d6b5fc7..da58e5a0 100644 --- a/R/brm_archetype_successive_effects.R +++ b/R/brm_archetype_successive_effects.R @@ -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( @@ -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( diff --git a/R/brm_data.R b/R/brm_data.R index 728a88dc..79b1e70c 100644 --- a/R/brm_data.R +++ b/R/brm_data.R @@ -340,9 +340,13 @@ brm_data_validate.default <- function(data) { for (column in c(group, subgroup, time)) { assert( is.atomic(data[[column]]) || is.factor(data[[column]]), + !is.factor(data[[column]]) || !anyNA(levels(data[[column]])), message = paste( column, - "column in the data must be an atomic or factor type." + paste( + "column in the data must be an atomic or factor type,", + "and all factor levels must be non-missing." + ) ) ) } @@ -393,6 +397,7 @@ brm_data_fill.brms_mmrm_data <- function(data) { missing <- attr(data, "brm_missing") interest <- attr(data, "brm_archetype_interest") nuisance <- attr(data, "brm_archetype_nuisance") + data <- droplevels(data) args <- list(data = data, as.symbol(patient), as.symbol(time)) data <- do.call(what = tidyr::complete, args = args) args <- list(.data = data, as.symbol(patient), as.symbol(time)) @@ -452,7 +457,7 @@ brm_time_contrasts <- function(data) { } brm_levels <- function(x) { - if_any(is.factor(x), levels(x), sort(unique(x))) + if_any(is.factor(x), intersect(levels(x), unique(x)), sort(unique(x))) } brm_data_fill_column <- function(x, index) { diff --git a/tests/testthat/test-brm_data.R b/tests/testthat/test-brm_data.R index bfed6c3b..1ad80692 100644 --- a/tests/testthat/test-brm_data.R +++ b/tests/testthat/test-brm_data.R @@ -339,6 +339,10 @@ test_that("brm_levels()", { expect_equal(brm_levels(c(3L, 2L, 1L, 2L, 3L)), c(1L, 2L, 3L)) x <- ordered(rep(c("a", "c", "b"), times = 2), levels = c("c", "b", "a")) expect_equal(brm_levels(x), c("c", "b", "a")) + expect_equal( + brm_levels(ordered(c("x", "y"), levels = c("z", "y", "x"))), + c("y", "x") + ) }) test_that("brm_data() deprecate level_control", {