I'm using a custom styling function to cap odds ratios and confidence intervals if they are below or above a certain number for ease of printing in a final table. All of the variables in my dataset work except for one, which is not unique in it's composition, as far as I can tell.
library(tidyverse)
library(gtsummary)
bounded_style_ratio <- function(x, min = -Inf, max = Inf, ...) {
dplyr::case_when(
x < min ~ paste0("<", gtsummary::style_ratio(min, ...)),
x > max ~ paste0(">", gtsummary::style_ratio(max, ...)),
is.na(x) == TRUE ~ NA_character_,
TRUE ~ gtsummary::style_ratio(x, ...)
)
}
dat_2 <- structure(list(con = structure(c(1L, 1L, 1L, 2L, 1L, 2L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L,
1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 2L,
1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 1L,
1L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 2L,
1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 1L,
1L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L,
2L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L,
1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L,
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L,
2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 1L,
1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L,
2L, 1L, 1L), .Label = c("0", "1"), class = "factor"), education_c = structure(c(2L,
5L, 5L, 3L, 4L, 4L, 4L, 2L, 3L, 5L, 3L, 3L, 4L, 3L, 4L, 4L, 3L,
4L, 2L, 5L, 4L, 3L, 3L, 5L, 5L, 4L, 3L, 2L, 1L, 5L, 5L, 5L, 2L,
2L, 4L, 4L, 5L, 3L, 5L, 3L, 4L, 5L, 5L, 3L, 5L, 3L, 4L, 3L, 5L,
5L, 5L, 4L, 3L, 5L, 5L, 4L, 2L, 5L, 3L, 4L, 3L, 4L, 4L, 5L, 4L,
5L, 3L, 4L, 3L, 5L, 5L, 4L, 2L, 5L, 4L, 2L, 5L, 5L, 4L, 3L, 4L,
4L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 3L, 3L, 5L, 4L, 2L, 2L, 5L, 4L,
5L, 4L, 3L, 5L, 4L, 2L, 4L, 3L, 4L, 5L, 4L, 2L, 3L, 5L, 5L, 2L,
5L, 3L, 4L, 3L, 4L, 3L, 2L, 4L, 2L, 5L, 3L, 5L, 5L, 3L, 5L, 5L,
5L, 3L, 3L, 3L, 5L, 5L, 3L, 4L, 3L, 4L, 3L, 3L, 4L, 5L, 3L, 2L,
5L, 2L, 3L, 3L, 4L, 5L, 5L, 4L, 4L, 3L, 4L, 4L, 5L, 4L, 4L, 5L,
3L, 5L, 4L, 4L, 5L, 4L, 3L, 5L, 2L, 5L, 4L, 5L, 4L, 4L, 4L, 4L,
3L, 4L, 5L, 3L, 4L, 5L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 4L, 4L, 4L,
3L, 4L, 5L, 5L, 4L, 4L, 4L, 4L, 5L, 4L, 3L, 2L, 3L, 4L, 5L, 4L,
5L, 4L, 3L, 5L, 4L, 4L, 2L, 4L, 5L, 4L, 3L, 4L, 5L, 3L, 4L, 4L,
2L, 5L, 5L, 3L, 2L, 4L, 5L, 4L, 5L, 5L, 5L, 4L, 3L, 5L, 5L, 4L,
4L, 3L, 4L, 4L, 5L, 5L, 3L, 4L, 5L, 2L, 4L, 4L, 5L, 4L, 5L, 5L,
4L, 3L, 4L, 2L, 3L, 3L, 2L, 4L, 5L, 3L, 4L, 4L, 3L, 2L, 3L, 3L,
5L, 4L, 5L, 2L, 2L, 4L, 5L, 3L, 4L, 2L, 5L, 3L, 5L, 3L, 4L, 4L,
3L, 2L, 3L, 4L, 2L, 5L, 3L, 3L, 3L, 3L, 5L, 3L, 5L, 3L, 5L, 5L,
5L, 4L, 3L, 5L, 3L, 2L, 4L, 4L, 1L, 4L, 2L, 3L, 3L, 3L, 5L, 4L,
5L, 2L, 5L, 4L, 3L, 4L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 3L, 4L,
4L, 5L, 5L, 4L, 3L, 4L, 4L, 3L, 2L), .Label = c("LTHS", "HS",
"LTBA", "BA", "PostBA"), class = "factor")), row.names = c(NA,
-346L), class = c("tbl_df", "tbl", "data.frame"))
dat_2 %>%
tbl_uvregression(
y = con,
method = glm,
method.args = list(family = binomial),
exponentiate = TRUE,
estimate_fun = purrr::partial(bounded_style_ratio, max = 2)
)
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning in regularize.values(x, y, ties, missing(ties), na.rm = na.rm):
#> collapsing to unique 'x' values
#> Error in `mutate_cols()`:
#> ! Problem with `mutate()` column `ci`.
#> i `ci = if_else(...)`.
#> x must be a character vector, not a logical vector.
#> Caused by error in `glubort()`:
#> ! must be a character vector, not a logical vector.
Created on 2022-02-10 by the reprex package (v2.0.1)
I understand the warnings around data fitting, and will likely discard this predictor downstream in data analysis, but I don't understand what's happening with the error in mutate_cols() section. Does anyone have insight into how I could update my formatting call to handle this error?
CodePudding user response：
The upper bound of confidence intervals are all NA in this example, and the custom function you've defined doesn't handle NA values. You'll need to update it to handle NA values, and it should work
bounded_style_ratio <- function(x, min = -Inf, max = Inf, ...) {
dplyr::case_when(
x < min ~ paste0("<", gtsummary::style_ratio(min, ...)),
x > max ~ paste0(">", gtsummary::style_ratio(max, ...)),
is.na(x) == TRUE ~ NA_character_,
TRUE ~ gtsummary::style_ratio(x, ...)
)
}
bounded_style_ratio(c(NA, NA))
#> Error in `glubort()`:
#> ! must be a character vector, not a logical vector.
Created on 2022-02-10 by the reprex package (v2.0.1)
Something like this should work:
bounded_style_ratio <- function(x, min = -Inf, max = Inf, ...) {
purrr::map_chr(
x,
function(x) {
if (isTRUE(x < min)) return(paste0("<", gtsummary::style_ratio(min, ...)))
if (isTRUE(x > max)) return(paste0(">", gtsummary::style_ratio(max, ...)))
gtsummary::style_ratio(x, ...)
}
)
}