Фильтрация на блестящем selectizeinput и отображение пустого графика, когда в наборе данных нет наблюдений, соответствующих входу

В моем блестящем приложении flexdashboard я использую selectizeInput() с тремя вариантами: «английский», «испанский» и «другой». В моем наборе данных о игрушках нет наблюдений за переменной lang, принимающей значение «другое». Следовательно, когда Только «другое» выбрано на панели ввода, R возвращает ошибку оценки:

missing value where TRUE/FALSE needed.

Это вызвано следующей строкой трубы в разделе «Страница 1»:

filter(if(is.null(input$foo)) (new==1) else (lang %in% input$foo)) %>%

Каков правильный подход к отображению пустого графика, когда в наборе данных нет наблюдений, принимающих значение входных данных?

---
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 <- sample_n(dat, 80)

```

Sidebar {.sidebar}
=====================================

```{r}
selectizeInput(
  'foo', label = NULL, 
  choices = c("english", "spanish", "other"),
  multiple = TRUE
)
```

Page 1
=====================================

```{r}
# all
  totals <- reactive({
  dat %>%
    mutate(new = 1) %>%
    arrange(date) %>%
    filter(if(is.null(input$foo)) (new==1) else (lang %in% input$foo)) %>%
  # 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) 
  })
```
0
0
284
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Один из способов сделать это - использовать функцию shiny::req для проверки требований перед запуском блока кода.

Если вы добавите:

req(dat$lang %in% input$foo)

в начало вашего выражения totals <- reactive({, затем он проверит, что значение input$foo находится в dat$lang, прежде чем запускать остальную часть этого выражения. Если он не найден, операция будет остановлена ​​без уведомления. Ошибка не будет отображаться, и график останется пустым.

очень круто. Добавление req(dat$lang %in% input$foo) дало мне пустой график по умолчанию, когда ничего не было выбрано, поэтому я добавил req((dat$lang %in% input$foo) | is.null(input$foo)) для построения нефильтрованного набора данных. Благодарность!

Eric Green 13.09.2018 19:20

Другие вопросы по теме