dygraph пуст, но объект xts имеет наблюдение - PullRequest
Новая
       13

dygraph пуст, но объект xts имеет наблюдение

0 голосов
/ 13 сентября 2018

Блестящая версия проблемы (оригинальный вопрос):

Я строю график, основанный на объекте xts, который является результатом фильтрации на основе 2 входных данных:age and language.

Если переместить ползунок возраста, чтобы установить нижнюю и верхнюю границу для каждого значения 32, и ввести «испанский» в поле ввода, график будет пустым.Однако как отфильтрованный тибл, так и отфильтрованный объект XTS показывают 1 наблюдение.Это наблюдение должно появиться на графике, но не появляется.

Мне кажется, что я здесь упускаю что-то очень простое, но не могу понять, что это.

enter image description here

---
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)

1 Ответ

0 голосов
/ 14 сентября 2018

Я думаю, что фундаментальная проблема заключается в том, что dygraph не будет отображать объект xts, состоящий из 1 строки.Таким образом, всякий раз, когда фильтры, установленные через блестящие входы (или статические вызовы фильтров), уменьшают набор данных до 1 соответствия (1 строка в объекте xts), график будет пустым.

(При нулевом совпадении в моем примере R выдает ошибку на шаге tibbletime, поскольку строк нет.)

...