Использование lapply с несколькими входами функций без вложенности - PullRequest
Новая
       5

Использование lapply с несколькими входами функций без вложенности

1 голос
/ 06 февраля 2020

У меня есть фрейм данных с четырьмя столбцами: два столбца указывают на участие в спорте, а два других столбца указывают, сдал ли игрок каждый из двух своих фитнес-экзаменов. 

dat <- data.frame(SOCCER = sample(0:1, 10, replace = T),
                  BASEBALL = sample(0:1, 10, replace = T),
                  TEST_1_PASS = sample(0:1, 10, replace = T),
                  TEST_2_PASS = sample(0:1, 10, replace = T))

Я хотел бы получить список, содержащий таблицы непредвиденных обстоятельств для каждого вида спорта и экзамена. Я знаю, что могу выполнить sh, используя следующий код, который использует вложенные операторы lapply, но это кажется мне неэффективным. Кто-нибудь может предложить более элегантное решение, которое не использует вложенность? 

results <- lapply(c("SOCCER", "BASEBALL"), function(x) {
  lapply(c("TEST_1_PASS", "TEST_2_PASS"), function(y){
    table(sport = dat[[x]], pass = dat[[y]])
  })
})

Спасибо, как всегда!

Ответы [ 2 ]

4 голосов
/ 06 февраля 2020

Двойной lapply получает все попарные комбинации столбцов в каждом из векторов столбцов, например @ Грегор , записанный в комментарии

Я не думаю, ваше вложение неэффективно ... вам нужно вызвать таблицу 4 раза. На самом деле не имеет значения, находится ли он внутри одной петли / лапы над 4-мя элементами или 2-мя вложенными петлями / лаппли с 2-мя элементами каждая. expand.grid. 

cols <- expand.grid(x = c("SOCCER", "BASEBALL"), 
                    y = c("TEST_1_PASS", "TEST_2_PASS"),
                    stringsAsFactors = FALSE)
Map(function(.x, .y)table(dat[[.x]], dat[[.y]]), cols$x, cols$y)
0 голосов
/ 06 февраля 2020

Подумайте о переформатировании ваших данных в длинный формат (т. Е. аккуратные данные ), объединив две части данных: sport и экзамен , а затем выполните by (редко используемый член семейства apply в качестве объектно-ориентированной оболочки для tapply) для всех комбинаций подмножеств между двумя, возвращающими именованный заголовок отчета о результатах: 

# RESHAPE EACH DATA SECTION (SPORT AND EXAM) INTO LONG FORMAT
df_list <- lapply(list(c("SOCCER", "BASEBALL"), c("TEST_1_PASS", "TEST_2_PASS")), function(cols)
                   reshape(cbind(PLAYER = row.names(dat), dat[cols]), 
                           varying = cols, v.names = "VALUE", 
                           times = cols, timevar = "INDICATOR", 
                           idvar = "PLAYER", ids = NULL,
                           new.row.names = 1:1E4, direction = "long")
           )

# CROSS JOIN (ALL COMBINATION PAIRINGS)
final_df <- Reduce(function(x,y) merge(x, y, by="PLAYER", suffixes=c("_SPORT", "_EXAM")), df_list)
final_df

# RUN TABLES FOR EACH SUBSET COMBINATION
tables_list <- with(final_df, by(final_df, list(INDICATOR_SPORT, INDICATOR_EXAM), function(sub)
                                  table(sport = sub$VALUE_SPORT, pass = sub$VALUE_EXAM)
                                )
                   )

Output 

tables_list

# : BASEBALL
# : TEST_1_PASS
#      pass
# sport 0 1
#     0 3 4
#     1 2 1
# ------------------------------------------------------------ 
# : SOCCER
# : TEST_1_PASS
#      pass
# sport 0 1
#     0 2 0
#     1 3 5
# ------------------------------------------------------------ 
# : BASEBALL
# : TEST_2_PASS
#      pass
# sport 0 1
#     0 3 4
#     1 1 2
# ------------------------------------------------------------ 
# : SOCCER
# : TEST_2_PASS
#      pass
# sport 0 1
#     0 2 0
#     1 2 6

Демонстрация в Интернете

...