R: преобразовать в множитель с порядком уровней, одинаковым с case_when
При проведении анализа данных мне иногда нужно перекодировать значения в факторы для проведения группового анализа. Я хочу оставить порядок коэффициентов таким же, как порядок конвертации, указанный в case_when, В этом случае порядок должен быть "Excellent" "Good" "Fail", Как я могу добиться этого без утомительного упоминания об этом, как в levels=c('Excellent', 'Good', 'Fail')?
Большое спасибо.
library(dplyr, warn.conflicts = FALSE)
set.seed(1234)
score <- runif(100, min = 0, max = 100)
Performance <- function(x) {
case_when(
is.na(x) ~ NA_character_,
x > 80 ~ 'Excellent',
x > 50 ~ 'Good',
TRUE ~ 'Fail'
) %>% factor(levels=c('Excellent', 'Good', 'Fail'))
}
performance <- Performance(score)
levels(performance)
#> [1] "Excellent" "Good" "Fail"
table(performance)
#> performance
#> Excellent Good Fail
#> 15 30 55
Изменить: мое решение
Наконец-то я придумал решение. Для тех, кто заинтересован, вот мое решение. Я написал функцию fct_case_when (притворяться, что функция в forcats). Это просто обертка case_when с фактором производства. Порядок уровней такой же, как порядок аргументов.
fct_case_when <- function(...) {
args <- as.list(match.call())
levels <- sapply(args[-1], function(f) f[[3]]) # extract RHS of formula
levels <- levels[!is.na(levels)]
factor(dplyr::case_when(...), levels=levels)
}
Теперь я могу использовать fct_case_when на месте case_whenи результат будет таким же, как предыдущая реализация (но менее утомительным).
Performance <- function(x) {
fct_case_when(
is.na(x) ~ NA_character_,
x > 80 ~ 'Excellent',
x > 50 ~ 'Good',
TRUE ~ 'Fail'
)
}
performance <- Performance(score)
levels(performance)
#> [1] "Excellent" "Good" "Fail"
table(performance)
#> performance
#> Excellent Good Fail
#> 15 30 55
5 ответов
Мое решение
Наконец, я придумал решение. Кому интересно, вот мое решение. Я написал функцию (притворился функцией в
forcats). Это просто оболочка с факторным выходом. Порядок уровней такой же, как и порядок аргументов.
fct_case_when <- function(...) {
args <- as.list(match.call())
levels <- sapply(args[-1], function(f) f[[3]]) # extract RHS of formula
levels <- levels[!is.na(levels)]
factor(dplyr::case_when(...), levels=levels)
}
Теперь я могу использовать
fct_case_whenна месте
case_when, и результат будет таким же, как и в предыдущей реализации (но менее утомительным).
Performance <- function(x) {
fct_case_when(
is.na(x) ~ NA_character_,
x > 80 ~ 'Excellent',
x > 50 ~ 'Good',
TRUE ~ 'Fail'
)
}
performance <- Performance(score)
levels(performance)
#> [1] "Excellent" "Good" "Fail"
table(performance)
#> performance
#> Excellent Good Fail
#> 15 30 55
Уровни устанавливаются в лексикографическом порядке по умолчанию. Если вы не хотите указывать их, вы можете настроить их так, чтобы лексикографический порядок был правильным (Performance1) или создать levels вектор, и используйте его при генерации коэффициента и при настройке уровней (Performance2). Я не знаю, сколько усилий или утомления может спасти вас, но вот они. Взгляните на мою третью рекомендацию, которая, по моему мнению, будет наименее утомительной.
Performance1 <- function(x) {
case_when(
is.na(x) ~ NA_character_,
x > 80 ~ 'Excellent',
x <= 50 ~ 'Fail',
TRUE ~ 'Good',
) %>% factor()
}
Performance2 <- function(x, levels = c("Excellent", "Good", "Fail")){
case_when(
is.na(x) ~ NA_character_,
x > 80 ~ levels[1],
x > 50 ~ levels[2],
TRUE ~ levels[3]
) %>% factor(levels)
}
performance1 <- Performance1(score)
levels(performance1)
# [1] "Excellent" "Fail" "Good"
table(performance1)
# performance1
# Excellent Fail Good
# 15 55 30
performance2 <- Performance2(score)
levels(performance2)
# [1] "Excellent" "Good" "Fail"
table(performance2)
# performance2
# Excellent Good Fail
# 15 30 55
Если бы я мог предложить еще менее утомительный способ:
performance <- cut(score, breaks = c(0, 50, 80, 100),
labels = c("Fail", "Good", "Excellent"))
levels(performance)
# [1] "Fail" "Good" "Excellent"
table(performance)
# performance
# Fail Good Excellent
# 55 30 15
Я использовал эту реализацию:
library(dplyr)
library(purrr)
library(rlang)
library(forcats)
factored_case_when <- function(...) {
args <- list2(...)
rhs <- map(args, f_rhs)
cases <- case_when(
!!!args
)
exec(fct_relevel, cases, !!!rhs)
}
numbers <- c(2, 7, 4, 3, 8, 9, 3, 5, 2, 7, 5, 4, 1, 9, 8)
factored_case_when(
numbers <= 2 ~ "Very small",
numbers <= 3 ~ "Small",
numbers <= 6 ~ "Medium",
numbers <= 8 ~ "Large",
TRUE ~ "Huge!"
)
#> [1] Very small Large Medium Small Large Huge!
#> [7] Small Medium Very small Large Medium Medium
#> [13] Very small Huge! Large
#> Levels: Very small Small Medium Large Huge!
Это дает то преимущество, что вам не нужно вручную указывать уровни факторов.
Я также отправил запрос функции в dplyr для этой функции: https://github.com/tidyverse/dplyr/issues/6029
Хотя мое решение заменяет ваш трубопровод грязной промежуточной переменной, это работает:
library(dplyr, warn.conflicts = FALSE)
set.seed(1234)
score <- runif(100, min = 0, max = 100)
Performance <- function(x) {
t <- case_when(
is.na(x) ~ NA_character_,
x > 80 ~ 'Excellent',
x > 50 ~ 'Good',
TRUE ~ 'Fail'
)
to <- subset(t, !duplicated(t))
factor(t, levels=(to[order(subset(x, !duplicated(t)), decreasing=T)] ))
}
performance <- Performance(score)
levels(performance)
Отредактировано, чтобы исправить!
Позволятьcase_when()вывести числа и использоватьlabelsаргумент вfactor():
library(dplyr, warn.conflicts = FALSE)
set.seed(1234)
score <- runif(100, min = 0, max = 100)
Performance <- function(x) {
case_when(
is.na(x) ~ NA_real_,
x > 80 ~ 1,
x > 50 ~ 2,
TRUE ~ 3
) %>% factor(labels=c('Excellent', 'Good', 'Fail'))
}
performance <- Performance(score)
levels(performance)
#> [1] "Excellent" "Good" "Fail"
table(performance)
#> performance
#> Excellent Good Fail
#> 15 30 55
Создано 13 января 2023 г. с использованием репрекса версии 2.0.2.