У меня блестящее приложение, в котором можно выбрать входы, которые фильтруют набор данных по 0 строкам. Наличие 0 строк приводит к тому, что некоторые функции выдают ошибку. Я пытаюсь понять, как структурировать приложение, чтобы справиться с ситуацией, когда возникает ошибка, когда набор данных фильтруется в 0 строк. Основываясь на других ответах SO ( пример ), я считаю, что одним из подходов является использование validate(), но я не уверен, как правильно реализовать. Это может быть помечено как дубликат, но я не думаю, что существующие ответы демонстрируют validate() для этого варианта использования (очень возможно, что я пропустил некоторые!).
Вот не блестящая MRE проблемы. Представьте, что шаг filter(age >= 36 & age <= 40) поступает из ползунка в блестящем приложении. Набор данных игрушек имеет возраст до 35 лет, поэтому установка нижней границы ползунка на 36 отфильтрует набор данных до 0 строк. (Ограничение диапазона ползунка не вариант, потому что данные могут измениться, и завтра может быть кто-то в возрасте 36 лет. В моем реальном случае использования есть несколько фильтров и множество путей до 0 строк.)
library(tidyverse)
library(dygraphs)
library(magrittr)
library(padr)
set.seed(1)
dat <- data.frame(date = seq(as.Date("2018-01-01"),
as.Date("2018-06-30"),
"days"),
sex = sample(c("male", "female"), 181, replace=TRUE),
lang = sample(c("english", "spanish"), 181, replace=TRUE),
age = sample(20:35, 181, replace=TRUE))
dat <- dplyr::sample_n(dat, 80)
grp_col <- rlang::sym("sex")
dat %>%
mutate(Total = 1) %>%
filter(age >= 36 & age <= 40) %>% # leads to 0 rows
mutate(my_group = !!grp_col) %>%
group_by(date = lubridate::floor_date(date, "1 week"), my_group) %>%
count() %>% spread(my_group, n) %>% ungroup() %>%
padr::pad() %>% replace(is.na(.), 0) %>%
xts::xts(order.by = .$date) %>%
dygraph() %>%
dyRangeSelector() %>%
dyOptions(
useDataTimezone = FALSE, stepPlot = TRUE,
drawGrid = FALSE, fillGraph = TRUE
)
Когда набор данных фильтруется до 0 строк, padr::pad() в этом примере выдает ошибку. Я ищу стратегию для построения графика, если rows > 0 после фильтрации или rows == 0, напечатать сообщение, например:
В наборе данных нет совпадений. Попробуйте удалить или ослабить один или несколько фильтров.
Блестящая версия, показывающая эту проблему:
Чтобы вызвать ошибку, перетащите ползунок нижнего возраста выше 35.
---
title: "test"
output:
flexdashboard::flex_dashboard:
theme: bootstrap
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(tibbletime)
library(dygraphs)
library(magrittr)
library(xts)
```
```{r global, include=FALSE}
# generate data
set.seed(1)
dat <- data.frame(date = seq(as.Date("2018-01-01"),
as.Date("2018-06-30"),
"days"),
sex = sample(c("male", "female"), 181, replace=TRUE),
lang = sample(c("english", "spanish"), 181, replace=TRUE),
age = sample(20:35, 181, replace=TRUE))
dat <- dplyr::sample_n(dat, 80)
```
Sidebar {.sidebar}
=====================================
```{r}
radioButtons("diss", label = "Disaggregation",
choices = list("All" = "Total",
"By Sex" = "sex",
"By Language" = "lang"),
selected = "Total")
sliderInput("agerange", label = "Age",
min = 15,
max = 99,
value = c(15, 99),
step=1)
```
Page 1
=====================================
```{r plot}
# credit to https://stackoverflow.com/a/52325173/841405
renderDygraph({
grp_col <- rlang::sym(input$diss) # This converts the input selection to a symbol
dat %>%
mutate(Total = 1) %>% # This is a hack to let us "group" by Total -- all one group
filter(age >= input$agerange[1] & age <= input$agerange[2]) %>%
# Here's where we unquote the symbol so that dplyr can use it to refer to a column.
# In this case I make a dummy column that's a copy of whatever column we want to group
mutate(my_group = !!grp_col) %>%
group_by(date = lubridate::floor_date(date, "1 week"), my_group) %>%
count() %>% spread(my_group, n) %>% ungroup() %>%
padr::pad() %>% replace(is.na(.), 0) %>%
xts::xts(order.by = .$date) %>%
dygraph() %>%
dyRangeSelector() %>%
dyOptions(
useDataTimezone = FALSE, stepPlot = TRUE,
drawGrid = FALSE, fillGraph = TRUE
)
})
```
Блестящая версия (нерабочая), которая пытается интегрировать validate():
---
title: "test"
output:
flexdashboard::flex_dashboard:
theme: bootstrap
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(tibbletime)
library(dygraphs)
library(magrittr)
library(xts)
```
```{r global, include=FALSE}
# generate data
set.seed(1)
dat <- data.frame(date = seq(as.Date("2018-01-01"),
as.Date("2018-06-30"),
"days"),
sex = sample(c("male", "female"), 181, replace=TRUE),
lang = sample(c("english", "spanish"), 181, replace=TRUE),
age = sample(20:35, 181, replace=TRUE))
dat <- dplyr::sample_n(dat, 80)
```
Sidebar {.sidebar}
=====================================
```{r}
radioButtons("diss", label = "Disaggregation",
choices = list("All" = "Total",
"By Sex" = "sex",
"By Language" = "lang"),
selected = "Total")
sliderInput("agerange", label = "Age",
min = 15,
max = 99,
value = c(15, 99),
step=1)
```
Page 1
=====================================
```{r plot}
# credit to https://stackoverflow.com/a/52325173/841405
renderDygraph({
grp_col <- rlang::sym(input$diss) # This converts the input selection to a symbol
filtered <-
dat %>%
mutate(Total = 1) %>% # This is a hack to let us "group" by Total -- all one group
filter(age >= input$agerange[1] & age <= input$agerange[2]) %>%
validate(need(nrow(filtered)<1, "Need at least 1 row"),
filtered %>%
mutate(my_group = !!grp_col) %>%
group_by(date = lubridate::floor_date(date, "1 week"), my_group) %>%
count() %>% spread(my_group, n) %>% ungroup() %>%
padr::pad() %>% replace(is.na(.), 0) %>%
xts::xts(order.by = .$date) %>%
dygraph() %>%
dyRangeSelector() %>%
dyOptions(
useDataTimezone = FALSE, stepPlot = TRUE,
drawGrid = FALSE, fillGraph = TRUE
)
)
})
```