Skip to content

Commit

Permalink
Fixes of interactions with logical terms
Browse files Browse the repository at this point in the history
  • Loading branch information
Nick Kennedy committed Dec 21, 2023
1 parent d90c0b1 commit ddaa758
Show file tree
Hide file tree
Showing 5 changed files with 28 additions and 21 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
Expand Up @@ -26,4 +26,3 @@ Suggests:
covr,
testthat,
vdiffr
RoxygenNote: 7.1.2
20 changes: 14 additions & 6 deletions R/forest_model.R
Expand Up @@ -241,7 +241,7 @@ forest_model <- function(model,
)
if (inherits(model, "coxph")) {
event_detail_tab <- lapply(
setNames(seq_len(ncol(model$y)), colnames(model$y)),
stats::setNames(seq_len(ncol(model$y)), colnames(model$y)),
function(y_col) {
apply(
cols,
Expand Down Expand Up @@ -277,10 +277,17 @@ forest_model <- function(model,
seq_along(interaction_terms),
function(i) {
if (term_row$interaction_terms_are_factors[[1]][i]) {
ilv <- tibble::tibble(
level = model$xlevels[[remove_backticks(interaction_terms[i])]],
label = paste0(interaction_terms[i], level)
)
if (term_row$interaction_terms_are_logical[[1]][i]) {
ilv <- tibble::tibble(
level = c("FALSE", "TRUE"),
label = paste0(interaction_terms[i], level)
)
} else {
ilv <- tibble::tibble(
level = model$xlevels[[remove_backticks(interaction_terms[i])]],
label = paste0(interaction_terms[i], level)
)
}
} else {
ilv <- tibble::tibble(level = NA, label = interaction_terms[i])
}
Expand Down Expand Up @@ -459,6 +466,7 @@ make_forest_terms_basic <- function(model) {
is_interaction = colSums(mdl_factors) > 1,
interaction_terms = lapply(term_label, function(tl) names(which(attr(mdl_terms, "factors")[, tl] == 1))),
interaction_vars = lapply(interaction_terms, remove_backticks),
interaction_terms_are_factors = lapply(interaction_vars, function(iv) mdl_data_classes_factors[iv])
interaction_terms_are_factors = lapply(interaction_vars, function(iv) mdl_data_classes_factors[iv]),
interaction_terms_are_logical = lapply(interaction_vars, function(iv) mdl_terms_are_logical[iv])
)
}
2 changes: 1 addition & 1 deletion R/model_frame_coxph_simple.R
@@ -1,5 +1,5 @@
model_frame_coxph_simple <- function(model) {
cph_terms <- terms(model)
cph_terms <- stats::terms(model)
fcall <- model$call
indx <- match(c("formula", "data", "weights", "subset",
"na.action", "cluster", "id", "istate"), names(fcall),
Expand Down
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.

0 comments on commit ddaa758

Please sign in to comment.