Использование пользовательской функции case_when в mutate dplyr

Вопрос или проблема

Я просмотрел много постов, связанных с моим вопросом, но не могу разобраться с моей проблемой.

У меня есть базовая таблица, которая будет иметь дополнительные столбцы по мере продолжения сезона НФЛ. Я не могу заставить свою функцию с использованием case_when, основанную на неделе, работать без возврата “! объект ‘WK1’ не найден”

Мои данные после второй недели.

NumCorrect <- data.frame(
  TEAM = c(A:E),
  WK1 = c(11,12,11,12,13),
  WK2 = c(7,7,9,10,7)
)

Мой код.

# Определенная переменная в верхней части кода, которую я меняю по мере прохождения недель.
curWEEK = 2

# Упрощенная версия моего кода dplyr на этапе, который не работает. 
correct_d <- mutate(AVG_16 = average16(curWEEK))

Моя функция.

average16 <- function(x) {case_when(x == 1 ~ WK1,
                                    x == 2 ~ round(mean((WK1:WK2), na.rm=TRUE),1),
                                    x == 3 ~ round(mean((WK1:WK3), na.rm=TRUE),1),
                                    x %in% 4:7 ~ round(mean((WK1:WK4), na.rm=TRUE),1),
                                    x %in% 8:11 ~ round(mean(c(WK1:WK4,WK8), na.rm=TRUE),1),
                                    x %in% 12:14 ~ round(mean(c(WK1:WK4,WK8,WK12), na.rm=TRUE),1),
                                    x == 15 ~ round(mean(c(WK1:WK4,WK8,WK12,WK15), na.rm=TRUE),1),
                                    x == 16 ~ round(mean(c(WK1:WK4,WK8,WK12,WK15:WK16), na.rm=TRUE),1),
                                    x == 17 ~ round(mean(c(WK1:WK4,WK8,WK12,WK15:WK17), na.rm=TRUE),1),
                                    x == 18 ~ round(mean(c(WK1:WK4,WK8,WK12,WK15:WK18), na.rm=TRUE),1)
                                    )}

Я пытался заставить R и chatGPT разобраться, но функция становилась все более запутанной без решения.

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

Я пробовал много версий и смог изменить код так, чтобы оставить все столбцы недель (WK1 до WK18) с непроведенными неделями как NA, но все равно получал ошибку ‘Объект не найден’.

Ошибка каждый раз:

Ошибка в `mutate()`:
ℹ В аргументе: `AVG_16
  = average16(curWEEK)`.
ℹ В строке 1.
Вызвано ошибкой в `case_when()`:
! Не удалось оценить
  правую часть
  формулы 1.
Вызвано ошибкой:
! объект 'WK1' не найден

Я также попробовал следующее:

average16 <- function(x) {if(x == 1) {WK1}
                          if(x == 2) {round(mean((WK1:WK2), na.rm=TRUE),1)}
                          if(x == 3) {round(mean((WK1:WK3), na.rm=TRUE),1)}
                          if(x %in% 4:7)   {round(mean((WK1:WK4), na.rm=TRUE),1)}
                          if(x %in% 8:11)  {round(mean(c(WK1:WK4,WK8), na.rm=TRUE),1)}
                          if(x %in% 12:14) {round(mean(c(WK1:WK4,WK8,WK12), na.rm=TRUE),1)}
                          if(x == 15) {round(mean(c(WK1:WK4,WK8,WK12,WK15), na.rm=TRUE),1)}
                          if(x == 16) {round(mean(c(WK1:WK4,WK8,WK12,WK15:WK16), na.rm=TRUE),1)}
                          if(x == 17) {round(mean(c(WK1:WK4,WK8,WK12,WK15:WK17), na.rm=TRUE),1)}
                          if(x == 18) {round(mean(c(WK1:WK4,WK8,WK12,WK15:WK18), na.rm=TRUE),1)}
                          }

Ответ или решение

Ваша проблема заключается в том, что функция case_when из пакета dplyr не может получить доступ к переменным WK1, WK2, и так далее, поскольку они не находятся в соответствующем контексте (который ожидает работы с данными в пределах data.frame).

Чтобы решить эту проблему, вам необходимо изменить способ, которым вы получаете доступ к значениям временных переменных внутри функции. Вместо попытки альтернативно ссылаться на клетки по имени столбца (например, WK1, WK2), эффективнее будет использовать функцию dplyr::select вместе с mutate. Таким образом, пример вашего кода может выглядеть следующим образом:

library(dplyr)

# Определите вашу таблицу данных
NumCorrect <- data.frame(
  TEAM = c("A", "B", "C", "D", "E"),
  WK1 = c(11, 12, 11, 12, 13),
  WK2 = c(7, 7, 9, 10, 7)
)

# Определите текущую неделю
curWEEK <- 2

# Определите функцию для вычисления средних значений
average16 <- function(data, week) {
  if (week == 1) {
    return(data$WK1)
  } else if (week == 2) {
    return(round(mean(data[, c("WK1", "WK2")], na.rm = TRUE), 1))
  } else if (week == 3) {
    return(round(mean(data[, c("WK1", "WK2", "WK3")], na.rm = TRUE), 1))
  } else if (week %in% 4:7) {
    return(round(mean(data[, c("WK1", "WK2", "WK3", "WK4")], na.rm = TRUE), 1))
  } else if (week %in% 8:11) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8), na.rm = TRUE), 1))
  } else if (week %in% 12:14) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8, data$WK12), na.rm = TRUE), 1))
  } else if (week == 15) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8, data$WK12, data$WK15), na.rm = TRUE), 1))
  } else if (week == 16) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8, data$WK12, data$WK15, data$WK16), na.rm = TRUE), 1))
  } else if (week == 17) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8, data$WK12, data$WK15, data$WK16, data$WK17), na.rm = TRUE), 1))
  } else if (week == 18) {
    return(round(mean(c(data$WK1, data$WK2, data$WK3, data$WK4, data$WK8, data$WK12, data$WK15, data$WK16, data$WK17, data$WK18), na.rm = TRUE), 1))
  }
}

# Используйте mutate и вашу функцию
correct_d <- NumCorrect %>%
  mutate(AVG_16 = average16(., curWEEK))

print(correct_d)

В этом коде:

  1. Мы изменяем определение average16, чтобы она принимала data в качестве первого аргумента, контекстом которого является ваш data.frame.
  2. x получаем доступ к неделям через data$WKX, что позволяет избежать ошибок, связанных с отсутствующими переменными.

Такой подход позволяет динамически обработать данные даже при добавлении новых недель к data.frame. Кода также показывает, как итоговые результаты могут быть вычислены и добавлены в новую колонку AVG_16.

Оцените материал
Добавить комментарий

Капча загружается...