Вычисление коэффициента шансов между несколькими столбцами данных

Question

У меня есть следующий фрейм данных:

structure(list(id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15), var1 = c(1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 
1, 1), var2 = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1), 
    var3 = c(1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1), var4 = c(0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1), outcome = c(1, 
    1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1)), row.names = c(NA, 
-15L), class = c("tbl_df", "tbl", "data.frame"))

Я хотел бы организовать сценарий для расчета всех возможных коэффициентов (с использованием квадрата хи) с 95% значениями CI и p между всеми столбцами и исход колонки. Как я могу это сделать?

Я установил epitools, но, похоже, мне нужна таблица непредвиденных обстоятельств 2x2, и я не могу применить эту функцию к столбцам кадра данных

Answer 1

С mapply, вы можете использовать функцию fisher.test, которая не перестает работать, когда коэффициент шансов не может быть рассчитан.

mapply(fisher.test, x=data[, grep("var", names(data))], y=data[,"outcome"])

Но на выходе получается матрица 7x4, которую нельзя убрать в хороший формат. Однако мы можем использовать lapply, чтобы выполнить тест Фишера для каждого столбца, а затем привести результаты в соответствие с пакетом метла .

library(broom)

cols <- df1[,grep("var", names(df1))]
res_list <- lapply(as.list(cols), function(x) fisher.test(x, y=df1$outcome))
do.call(rbind, lapply(res_list, broom::tidy))

# A tibble: 4 x 6
  estimate p.value conf.low conf.high method                alternative
     <dbl>   <dbl>    <dbl>     <dbl> <chr>                 <chr>      
1     0      1        0          77.9 Fisher's Exact Test ~ two.sided  
2   Inf      0.505    0.204     Inf   Fisher's Exact Test ~ two.sided  
3     2.13   0.608    0.160      37.2 Fisher's Exact Test ~ two.sided  
4   Inf      0.505    0.204     Inf   Fisher's Exact Test ~ two.sided

Или с помощью dplyr с map, сначала изменяя форму, а затем разделяя имя.

library(dplyr)

df1 %>%
  pivot_longer(cols=starts_with("var")) %>%
  split(.$name) %>%
  map(~fisher.test(x=.$value, y=.$outcome)) %>%
  map(tidy) %>%
  map_df(~as_tibble(.))

---

Данные :

df1 <- structure(list(id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15), var1 = c(1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 
1, 1), var2 = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1), 
    var3 = c(1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1), var4 = c(0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1), outcome = c(1, 
    1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1)), row.names = c(NA, 
-15L), class = c("tbl_df", "tbl", "data.frame"))

Answer 2

Следующий код выполняет вычисления, как описано в вопросе, но 3/4 выдает ошибки.

library(epitools)

cols <- grep("var", names(df1), value = TRUE)
res_list <- lapply(cols, function(v){
  tbl <- table(df1[, c(v, "outcome")])
  tryCatch(oddsratio(x = tbl), error = function(e) e)
})

ok <- !sapply(res_list, inherits, "error")
res_list[ok]

Все ошибки:

simpleError в uni root (функция (или) {1 - середина (a1, a0, b1, b0 или) - alpha / 2}, интервал = интервал): значения f () в конечных точках не противоположны знаку

, который можно увидеть с

res_list[!ok]