R Как я могу вычислить групповые средние значения для списка кадров данных, используя разные условия подмножества для вычисления каждого среднего значения?

Если у вас установлен dplyr, следующий код решит вашу проблему.

library(dplyr)

set.seed(1234)

a <- data.frame(c("fj","fj","fj","a","fj","a","g","g","g","g"),c(1,1,1,1,0,0,0,1,0,0),c(0,0,1,0,1,0,0,1,0,1),c(0,0,0,1,0,0,1,1,0,0),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)))
b <- data.frame(c("fj","a","fj","a","fj","fj","fj","g","g","g"),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)))
c <- data.frame(c("fj","fj","fj","a","fj","a","g","g","g","g"),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 0, max = 2)),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)),floor(runif(10, min = 10, max = 200)))
u <- list(a,b,c)
u <- lapply(u, setNames, nm = c('g1','dummy1','dummy2','dummy3','contin1','contin2','contin3'))


rates <- lapply(u, function(x)
  x %>% 
    mutate( contin1_ = ifelse(dummy1==1, contin1, NA) ) %>%
    mutate( contin2_ = ifelse(dummy2==1, contin2, NA) ) %>%
    mutate( contin3_ = ifelse(dummy3==1, contin3, NA) ) %>%
    group_by(g1) %>%
    summarize( 
              V1 = mean(dummy1, na.rm=TRUE),
              V2 = mean(dummy2, na.rm=TRUE),
              V3 = mean(dummy3, na.rm=TRUE),
              mean1 = mean(contin1_, na.rm=TRUE),
              mean2 = mean(contin2_, na.rm=TRUE),
              mean3 = mean(contin3_, na.rm=TRUE)
               )
)

print(rates[[1]])

Что дает мне это:

Source: local data frame [3 x 7]

  g1   V1  V2  V3     mean1 mean2 mean3
1  a 0.50 0.0 0.5 128.00000   NaN    17
2 fj 0.75 0.5 0.0  94.66667    64   NaN
3  g 0.25 0.5 0.5  54.00000    57   146

Число, которое я получаю, кажется примерно правильным, и NA находятся во всех нужных местах. К сожалению, ваш пример воспроизводим не полностью, поскольку вы не указали начальное число для генерации случайных переменных, и поэтому мой runif дает мне значения, отличные от ваших.

Другим вариантом может быть изменение формата с «широкого» на «длинный» и повторное преобразование обратно в «широкий» после получения «средних» значений. Для столбцов с несколькими значениями это теперь возможно с melt, dcast из версии devel data.table, т.е. v1.9.5. Его можно установить с here. (Использован тот же набор данных из поста @akhmed).

Мы можем melt установить наборы данных в списке ("u"), указав индекс столбцов ("dummy" и "contin") в measure.vars в виде списка. Получите среднее значение столбцов «dummy» и «contin», сгруппированных по «g1» и «variable» (созданный из «melt»), dcast от long до wide, указав value.vars как «dummyMean» и «continMean». .

 res <-  lapply(u, function(x) {
   x1 <- melt(setDT(x), measure.vars=list(2:4,5:7),
                        value.name=c('dummy', 'contin'))
   x2 <- x1[, list(dummyMean = mean(dummy, na.rm=TRUE),
             continMean = mean(contin[dummy==1], na.rm=TRUE)), 
                           by=list(g1, variable)]

  dcast(x2, g1~variable, value.var=c('dummyMean', 'continMean'))})

 res[[1]]
 #   g1 1_dummyMean 2_dummyMean 3_dummyMean 1_continMean 2_continMean
 #1:  a        0.50         0.0         0.5    128.00000          NaN
 #2: fj        0.75         0.5         0.0     94.66667           64
 #3:  g        0.25         0.5         0.5     54.00000           57
 #    3_continMean
 #1:           17
 #2:          NaN
 #3:          146

Или вариант base R с использованием Map. Созданы функции «fdummy», «fcontin» для подмножества столбцов «dummy» и «contin». Цикл через 'u' (lapply(...)). Используйте Map, чтобы получить соответствующие столбцы "dummy" и "contin", сгруппированные по столбцу "g1", получите mean из "dummy" и mean из "contin" столбцов с "dummy==1", используя tapply, cbind результаты. .

 fdummy <- function(x) x[grep('dummy', names(x))]
 fcontin <- function(x) x[grep('contin', names(x))]
 res2 <- lapply(u, function(x) {
        do.call(cbind.data.frame,
           Map(function(x,y,z) cbind(tapply(x,z, FUN=mean), 
                              tapply(y[x==1],z[x==1], FUN=mean)), 
                             fdummy(x), fcontin(x), x['g1']))})


lapply(res2, setNames, c(rbind(paste0('dummyMean', 1:3), 
                    paste0('continMean',1:3))))[[1]]
#    dummyMean1 continMean1 dummyMean2 continMean2 dummyMean3 continMean3
#a        0.50   128.00000        0.0          NA        0.5          17
#fj       0.75    94.66667        0.5          64        0.0          NA
#g        0.25    54.00000        0.5          57        0.5         146