Блог

У меня есть список столбцов, номер которых относится к каждой категории

   list.group <-list(list(id = 2, type = "num"), list(id = 3, type = "num"), 
        list(id = 4, type = "cat"), list(id = 5, type = "cat"))
 

У меня есть функция, в которой есть 2 теста(тест Уилкокса и тест Фишера) для столбцов с типом «num», я хочу, чтобы выполнялся тест Уилкокса, а для типа «cat» выполняется тест Фишера.

Сначала я беру список и делю его на 2 списка( список столбцов и список категорий).:

 w = unlist(list.group, recursive = TRUE)
w.length = length(w)
col.id   = w[seq(1,w.length,2)]
col.type = w[seq(2,w.length,2)]
col.id    = as.integer(col.id)
col.type = as.character(col.type)
 

Функция:

 combination <- list(c(3,24),c(3,14))
wilcox.fun <- function(df, id_group){
  df = df[df$GROUP%in%id_group,]
 x <- function(dat) { 
  do.call(rbind, lapply(combination, function(x) {
    if(col.type=="num"){
       test <- wilcox.test(dat[[x[1]]], dat[[x[2]]])}
    if(col.type=="cat"){
       test1 <- fisher.test(dat[[x[1]]], dat[[x[2]]])}
    data.frame(Test = sprintf('Group %s by Group %s Group',x[1],x[2]), 
               #W = round(test$statistic,4), 
               p = test$p.value,
               p1 = test1$p.value,
               #median=paste(x[1],median.group.1,x[2],median.group.2),
               nmat = table(dat[[x[1]]]),
               nmat1 = round((prop.table(table(dat[[x[1]]]), 1) * 100), 1),
               nmat2=table(dat[[x[2]]]) 
               )
  }))
 }
 return (purrr::map_df(split(df, df$GROUP),x,.id="GROUP" ))
}
 

фрейм данных:

 data <- structure(list(GROUP = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L), 
    col1 = c(23L, 432L, 234L, 234L, 3123L, 657L, 8768L, 123L, 
    42323L), col2 = c(567L, 765L, 8678L, 46L, 35L, 24L, 76L, 
    789L, 45L), col3 = c(1L, 3L, 5L, 7L, 8L, 0L, 8L, 7L, 3L), 
    col4 = c("S", "S", "S", "S", "F", "F", "F", "F", "F")), class = "data.frame", row.names = c(NA, 
-9L))
 

Вместо того, чтобы иметь отдельный вектор ( col.id и col.type ), вы можете проверить класс столбцов, которые передаются в функции. Если оба столбца lapply числовые, мы проводим тест Уилкокса или тест Фишера.

Также я не думаю, что наличие table(...) и prop.table(table(...)) в фрейме данных будет работать, потому что созданный фрейм данных представляет собой фрейм данных с 1 строкой, в то время как table у него будет вывод длины > 1. Кроме этого> table(dat[[x[1]]]) , а table(dat[[x[2]]]) также может быть вывод различной длины, что создаст проблемы при построении фрейма данных.

 wilcox.fun <- function(df, id_group){
  df = df[df$GROUP%in%id_group,]
  x <- function(dat) { 
    do.call(rbind, lapply(combination, function(x) {
      col1 <- dat[[x[1]]]
      col2 <- dat[[x[2]]]
      if(is.numeric(col1) amp;amp; is.numeric(col2)) test <- wilcox.test(col1, col2)
      else  test <- fisher.test(col1, col2)
      data.frame(Test = sprintf('Group %s by Group %s Group',x[1],x[2]), 
                 #W = round(test$statistic,4), 
                 p = test$p.value
      )
    }))
  }
  return (purrr::map_df(split(df, df$GROUP),x,.id="GROUP" ))
}

wilcox.fun(data, c(1, 2))
 

Если вы хотите явно передать col.type , он должен иметь ту же структуру combination , что и, а затем вы можете использовать Map —

 col_type_list <- list(col.type[1:2], col.type[3:4])

wilcox.fun <- function(df, id_group){
  df = df[df$GROUP%in%id_group,]
  x <- function(dat) { 
    do.call(rbind, Map(function(x, y) {
      col1 <- dat[[x[1]]]
      col2 <- dat[[x[2]]]
      if(all(y == 'num')) test <- wilcox.test(col1, col2)
      else  test <- fisher.test(col1, col2)
      data.frame(Test = sprintf('Group %s by Group %s Group',x[1],x[2]), 
                 #W = round(test$statistic,4), 
                 p = test$p.value
      )
    }, combination, col_type_list))
  }
  return (purrr::map_df(split(df, df$GROUP),x,.id="GROUP" ))
}