Проблемы с реактивным объектом внутри выражения eventReactive - PullRequest
Новая
       6

Проблемы с реактивным объектом внутри выражения eventReactive

0 голосов
/ 13 июня 2018

Я получаю сообщение об ошибке: «Предупреждение: Ошибка в [.data.frame: выбраны неопределенные столбцы» в моем приложении Shiny.Для простоты мой воспроизводимый пример отображает только выходные данные таблицы, но при реальном использовании у меня есть объект карты листовки, который всегда использует выбранный столбец в качестве аргумента значений, который создается renderTable.Цель состоит в том, чтобы с помощью пользовательского ввода создать отфильтрованный фрейм данных.

Как вы можете видеть, я использую объект renderUI, потому что мне нужны гибкие диапазоны в моем виджете слайдера.Из-за этого мне нужен объект eventReactive, который в конце фильтрует фрейм данных в два столбца: «сущность» и столбец значений ввода пользователя. 

library(shiny)
library(tidyverse)


entity <- c('A', 'B', 'C', 'D', 'E')
ge <- data.frame(entity, replicate(16,sample(0:100,5,rep=TRUE)))
names(ge) <- c('entity', 
               'first_u7_2011','first_u7_2012','first_u7_2013','first_u7_2014',
               'first_79_2011','first_79_2012','first_79_2013','first_79_2014',
               'second_u7_2013','second_u7_2014',
               'second_79_2013','second_79_2014',
               'third_u7_2013','third_u7_2014',
               'third_79_2015','third_79_2016')

Gruppe <- c("Unter 7", "7-9 Jahre")
Kategorie <- c("first", "second", "third")

zeitraum.list <- list(jahre_first_u7 = c(2011:2014),
                      jahre_first_79 = c(2011:2014),
                      jahre_second_u7 = c(2013:2014),
                      jahre_second_79 = c(2013:2014),
                      jahre_third_u7 = c(2013:2014),
                      jahre_third_79 = c(2015:2016))


#UI Seite
ui <- fluidPage(
  titlePanel(""),
  sidebarLayout(position = "left",
                sidebarPanel(
                  selectInput("Gruppe", label = "Gruppe:", Gruppe),
                  selectInput("Kategorie", label = "Kategorie:", Kategorie),
                  uiOutput("Slider")),
                mainPanel("Tabelle", tableOutput("tableview"))))


#Server Seite
server <- function(input, output, session) {


  gruppe <- reactive({
    switch(input$Gruppe,
           "Unter 7" = select(ge, entity, matches("u7")),
           "7-9 Jahre" = select(ge, entity, matches("79")))
  })

  kategorie <- reactive({
    switch(input$Kategorie,
           "first" = select(gruppe(), entity, matches("first")),
           "second" = select(gruppe(), entity, matches("second")),
           "third" = select(gruppe(), entity, matches("third")))
  })

  zeitraum1 <- reactive({
    switch(input$Gruppe,
           "Unter 7" = zeitraum.list[c(1,3,5)],
           "7-9 Jahre" = zeitraum.list[c(2,4,6)])
  })

  zeitraum2 <- reactive({
    switch(input$Kategorie,
           "first" = zeitraum1()[[1]],
           "second" = zeitraum1()[[2]],
           "third" = zeitraum1()[[3]])
  })




  output$Slider <- renderUI({
    if (is.null(input$Kategorie))
      return()
    switch(input$Kategorie,
           "first" = sliderInput("inSlider", "Zeitleiste:",
                                           min = min(zeitraum2()),
                                           max = max(zeitraum2()),
                                           step = 1,
                                           value = min(zeitraum2()),
                                           sep = ""),
           "second" = sliderInput("inSlider", "Zeitleiste:",
                                            min = min(zeitraum2()),
                                            max = max(zeitraum2()),
                                            step = 1,
                                            value = min(zeitraum2()),
                                            sep = ""),
           "third" = sliderInput("inSlider", "Zeitleiste:",
                                            min = min(zeitraum2()),
                                            max = max(zeitraum2()),
                                            step = 1,
                                            value = min(zeitraum2()),
                                            sep = ""))

  })


  filtered <- eventReactive(req(input$inSlider, kategorie()), {
    if(input$inSlider == "2011"){filtered = select(kategorie(), entity, matches("2011"))}
    if(input$inSlider == "2012"){filtered = select(kategorie(), entity, matches("2012"))}
    if(input$inSlider == "2013"){filtered = select(kategorie(), entity, matches("2013"))}
    if(input$inSlider == "2014"){filtered = select(kategorie(), entity, matches("2014"))}
    if(input$inSlider == "2015"){filtered = select(kategorie(), entity, matches("2015"))}
    if(input$inSlider == "2016"){filtered = select(kategorie(), entity, matches("2016"))}
    return(filtered) 
  })


  output$tableview <- renderTable({
    table <- filtered()[, c(1,2)]
    head(table[, c(1,2)], n = 5)
  })

}

shinyApp(ui, server)

Ошибка всегда возникает, когда ввод пользователя изменяется наВход «Kategorie» или «Группа», где значение слайдера последнего виджета слайдера отсутствует в новом сгенерированном слайдере.Например: если вы запустите приложение и просто измените вход «Kategorie» на «третий».Это чрезвычайно проблематично для объекта листовки, потому что приложение не только выдает ошибку, но и полностью аварийно завершает работу.Я почти уверен, что проблема в выражении eventReactive, потому что в только что приведенном примере, реактивный объект не знает, как игнорировать возможный ввод пользователем значения времени, которого нет в его диапазоне ползунка.

Как мне этого добиться?Любая помощь с благодарностью!

1 Ответ

0 голосов
/ 14 июня 2018

Ваша проблема может быть решена легко и просто с помощью req.

Ваша проблема возникает, когда вы хотите получить доступ к большему количеству столбцов из фрейма данных, чем есть на самом деле.Поэтому просто добавьте оператор req, проверяющий, что фрейм данных имеет как минимум 2 столбца, и все работает нормально 

output$tableview <- renderTable({
    req(ncol(filtered()) > 1)
    table <- filtered()[, c(1,2)]
    head(table[, c(1,2)], n = 5)
  })

Надеюсь, это поможет !!

...