我有一个闪亮的应用程序，可以选择将数据集过滤为0行的输入。行数为0会导致某些函数抛出错误。我试图了解如何构建应用程序，以便可以处理将数据集过滤为0行时导致错误的情况。基于其他SO答案（example），我相信一种方法是使用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
)
)
})
```