Проблема с фильтром dplyr в R при попытке фильтрации на основе вероятности
Вопрос: Можно ли действительно надежно выполнить фильтрацию на основе прорисовки внутри фильтра, или она обречена на провал?
Цель: внутри dplyr::filter() удалить строки типа A (лиссатура), если случайный розыгрыш не удался, и удалить строки типа B (девственница), если розыгрыш пройден. Всегда следует заканчивать 5 случайными рядами данных сетозы и 1 случайной строкой либо вирджиники (шанс 1/8), либо лишайника (шанс 7/8).
Пытаться:
as_tibble(iris) %>%
group_by(Species) %>%
mutate(draw = case_when(
Species == "setosa" ~ 5,
Species == "versicolor" ~ 1,
Species == "virginica" ~ 1
)) %>%
slice(sample(n(),draw[1])) %>%
filter(
if (round(runif (1),3) <= 1/8){ Species != "versicolor" }
else { Species != "virginica" }
)
Проблема: хотя обычно это работает, возвращая только одно или другое, иногда я получаю оба или ни одного. Из любопытства оказалось, что я получаю и то, и другое в 11% случаев, ни 11% времени, и только одно (что правильно) только в 78% случаев.
Я понимаю, что одним из решений было бы завершить трубу после среза, а затем выполнить отрисовку внутри оператора if ():
data <- as_tibble(iris) %>%
group_by(Species) %>%
mutate(draw = case_when(
Species == "setosa" ~ 5,
Species == "versicolor" ~ 1,
Species == "virginica" ~ 1
)) %>%
slice(sample(n(),draw[1]))
if (round(runif (1),3) <= 1/8){
data %>%
filter(Species != "versicolor")
}
else {
data %>%
filter(Species != "virginica")
}
Однако, поскольку я понял, что отрисовку можно выполнить внутри фильтра, мне интересно узнать, практично ли это.
Ответы 1
Почему бы вам не вычислить вероятность раньше?
as_tibble(iris) %>%
mutate(prob = runif (1)) %>%
group_by(Species) %>%
mutate(draw = case_when(
Species == "setosa" ~ 5,
Species == "versicolor" ~ +(prob <= 1/8),
Species == "virginica" ~ +(prob > 1/8)
)) %>%
slice(sample(n(),draw[1]))
Выглядит чище, чем if ... else в конце.
Причина, по которой иногда он не печатает ни одного, или обоих, заключается в том, что вы извлекаете не одно случайное число, а 3! По одному на каждую группу.
filter в вашем коде применяется к сгруппированному data.frame, поэтому вы получаете случайное число для каждой группы.
Попробуйте запустить этот код. Вы увидите, что он напечатает 3 числа.
- Состояние сетоза не имеет значения.
- Случайное число для разноцветного цвета равно 0,095, что установит условие в значение TRUE и исключит разноцветный цвет из условия фильтра.
- Случайное число для вирджиники составляет 0,295, что больше 1/8. Условие является ЛОЖНЫМ, и вирджиния удаляется из конечного результата.
print_random_number <- function(x, Species){
cat(sprintf("%10s: %s <= 1/8 --> %s\n", Species, x, x <= 1/8))
x
}
set.seed(6)
as_tibble(iris) %>%
group_by(Species) %>%
mutate(draw = case_when(
Species == "setosa" ~ 5,
Species == "versicolor" ~ 1,
Species == "virginica" ~ 1
)) %>%
slice(sample(n(),draw[1])) %>%
filter(
if (print_random_number(round(runif (1),3), Species[1]) <= 1/8){ Species != "versicolor" }
else { Species != "virginica" }
)
#> setosa: 0.916 <= 1/8 --> FALSE
#> versicolor: 0.095 <= 1/8 --> TRUE
#> virginica: 0.295 <= 1/8 --> FALSE
#> # A tibble: 5 × 6
#> # Groups: Species [1]
#> Sepal.Length Sepal.Width Petal.Length Petal.Width Species draw
#> <dbl> <dbl> <dbl> <dbl> <fct> <dbl>
#> 1 4.9 3.1 1.5 0.1 setosa 5
#> 2 5.1 3.8 1.9 0.4 setosa 5
#> 3 4.3 3 1.1 0.1 setosa 5
#> 4 5 3.2 1.2 0.2 setosa 5
#> 5 4.7 3.2 1.3 0.2 setosa 5
Поэтому вы можете исправить свой код, просто добавив ungroup перед filter:
set.seed(6)
as_tibble(iris) %>%
group_by(Species) %>%
mutate(draw = case_when(
Species == "setosa" ~ 5,
Species == "versicolor" ~ 1,
Species == "virginica" ~ 1
)) %>%
slice(sample(n(),draw[1])) %>%
ungroup() %>%
filter(
# I added a print statement here to see what number was pulled
if (print(round(runif (1),3)) <= 1/8){ Species != "versicolor" }
else { Species != "virginica" }
)
#> [1] 0.916
#> # A tibble: 6 × 6
#> Sepal.Length Sepal.Width Petal.Length Petal.Width Species draw
#> <dbl> <dbl> <dbl> <dbl> <fct> <dbl>
#> 1 4.9 3.1 1.5 0.1 setosa 5
#> 2 5.1 3.8 1.9 0.4 setosa 5
#> 3 4.3 3 1.1 0.1 setosa 5
#> 4 5 3.2 1.2 0.2 setosa 5
#> 5 4.7 3.2 1.3 0.2 setosa 5
#> 6 6.4 3.2 4.5 1.5 versicolor 1
Да, это, конечно, намного чище! Не знаю, почему я не решил добавить его как часть случая_когда, но это определенно лучше, чем вставлять его в конец. Неплохо заметить, что для каждой группы будет выполняться жеребьевка!