dygraph is blank but xts object has an observation - r

Question

Shiny version of the problem (original question):
I am plotting a dygraph that is based on an xts object that is the result of filtering based on 2 inputs: age and language.
If I move the age slider to have a lower and upper bound each set at 32 AND enter "spanish" in the input box, the plot is empty. However, the filtered tibble and the filtered xts object both show 1 observation. This observation should appear in the plot but doesn't.
I feel like I am missing something very basic here, but I can't put my finger on it.
---
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))
})
```
Non-shiny version:
I moved my example out of shiny (my actual use case) to isolate the problem.
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)

Answer 1

I think the fundamental issue is that dygraph will not plot an xts object consisting of 1 row. So whenever filters set via shiny inputs (or static filter calls) reduce the dataset to 1 match (1 row in the xts object), the plot will be empty.
(If there are zero matches, R throws an error in my example at the tibbletime step because there are no rows.)