我有一个闪亮的应用程序,可以选择将数据集过滤为0行的输入。有0行会导致某些函数抛出错误。我正在尝试理解如何构造应用程序,以便处理当数据集被过滤到0行时出现错误的情况。基于其他答案(
example
validate()
验证()
对于这个用例(很可能我错过了一些!)。
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
)
})
```
验证()
---
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
)
)
})
```
