问题的闪亮版本(原始问题):
我正在绘制一个基于
xts
如果我移动“年龄”滑块,使上下限分别设置为32,并在输入框中输入“西班牙语”,则绘图为空。但是,过滤的tibble和过滤的xts对象都显示1个观察值。这种观察应该出现在情节中,但没有。
---
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)
library(DT)
```
```{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 <- sample_n(dat, 80)
```
Sidebar {.sidebar}
=====================================
```{r}
sliderInput("agerange", label = "Age",
min = 20,
max = 35,
value = c(20, 35),
step=1)
selectizeInput(
'foo', label = NULL,
choices = c("english", "spanish", "other"),
multiple = TRUE
)
```
Plot
=====================================
```{r}
# all
filtered <- reactive({
req((dat$lang %in% input$foo) | is.null(input$foo))
dat %>%
mutate(new = 1) %>%
arrange(date) %>%
filter(if(is.null(input$foo)) (new==1) else (lang %in% input$foo)) %>%
filter(age >= input$agerange[1] & age <= input$agerange[2])
})
totals <- reactive({
filtered <- filtered()
filtered %>%
# time series analysis
tibbletime::as_tbl_time(index = date) %>% # convert to tibble time object
select(date, new) %>%
tibbletime::collapse_by("1 week", side = "start", clean = TRUE) %>%
group_by(date) %>%
mutate(total = sum(new, na.rm = TRUE)) %>%
distinct(date, .keep_all = TRUE) %>%
ungroup() %>%
# expand matrix to include weeks without data
complete(
date = seq(date[1], date[length(date)], by = "1 week"),
fill = list(total = 0)
)
})
# convert to xts
totals_ <- reactive({
totals <- totals()
xts(totals, order.by = totals$date)
})
# plot
renderDygraph({
totals_ <- totals_()
dygraph(totals_[, "total"]) %>%
dyRangeSelector() %>%
dyOptions(useDataTimezone = FALSE,
stepPlot = TRUE,
drawGrid = FALSE,
fillGraph = TRUE)
})
```
Filtered Tibble
=====================================
```{r}
DT::renderDataTable({
filtered <- filtered()
DT::datatable(filtered,
options = list(bPaginate = TRUE))
})
```
Filtered xts
=====================================
```{r}
DT::renderDataTable({
totals_ <- totals_()
DT::datatable(totals_[, c("date", "total")],
options = list(bPaginate = TRUE))
})
```
无光泽版本:
library(tidyverse)
library(tibbletime)
library(dygraphs)
library(magrittr)
library(xts)
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 <- sample_n(dat, 80)
totals <-
dat %>%
mutate(new = 1) %>%
arrange(date) %>%
filter(lang=="spanish") %>%
filter(age>=32 & age<=32) %>%
{. ->> filtered} %>%
tibbletime::as_tbl_time(index = date) %>% # convert to tibble time object
select(date, new) %>%
tibbletime::collapse_by("1 week", side = "start", clean = TRUE) %>%
group_by(date) %>%
mutate(total = sum(new, na.rm = TRUE)) %>%
distinct(date, .keep_all = TRUE) %>%
ungroup() %>%
# expand matrix to include weeks without data
complete(
date = seq(date[1], date[length(date)], by = "1 week"),
fill = list(total = 0))
filtered
# date sex lang age new
#1 2018-01-25 male spanish 32 1
# convert to xts
totals_ <- xts(totals, order.by = totals$date)
totals_
# date new total
#2018-01-21 "2018-01-21" "1" "1"
# plot
dygraph(totals_[, "total"]) %>%
dyRangeSelector() %>%
dyOptions(useDataTimezone = FALSE,
stepPlot = TRUE,
drawGrid = FALSE,
fillGraph = TRUE)
