相互依赖的闪亮输入导致2个输入崩溃

时间:2019-08-26 09:37:05

标签: r shiny

在下面的示例中,selectInputs可以很好地工作,直到我一起选择它们为止。 我希望输入是相互依赖的。在级联输入中,一切正常! 问题可能与我认为的变量条件有关

感谢帮助!

有关洲和国家/地区的数据,如果您选择一个洲,您将能够看到该洲的所有国家/地区。但是,当我单击特定国家/地区时,该应用似乎已重置

df <- structure(list(Continent = c("Asia", "Oceania", "Europe", 
      "North America", "Europe", "Oceania", "Europe", "South America",
      "North America","Europe"), Country = c("India", "Tonga", "Georgia",
      "United States", "Spain", "New Zealand", "Sweden", "Suriname", 
      "United States","Finland"), State = c("Haryana", "State_Tonga", 
      "State_Georgia", "Florida", "State_Spain", "State_New Zealand", 
      "State_Sweden", "State_Suriname", "Idaho", "State_Finland"), 
      Population = c(25353081, 985883, 860759, 589096, 352490, 363655,
      143215, 961911, 579311, 131878)), row.names = c(NA, -10L), 
      class = c("tbl_df", "tbl", "data.frame"))

library(shiny)                                                                                                                                                                                                                 
library(shinydashboard)
library(dplyr)
library(DT)

is.not.null <- function(x) !is.null(x)


header <- dashboardHeader(
  title = "Test",
  dropdownMenu(type = "notifications",
               notificationItem(
                 text = "RAS",
                 icon("cog", lib = "glyphicon")
               )
  )
)
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Data", tabName = "ShowData", icon = icon("dashboard")),
    menuItem("Summary", tabName = "ShowSummary", icon = icon("bar-chart-o"))
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "ShowData",
            DT::dataTableOutput("table")
    ),
    tabItem(tabName = "ShowSummary",
            box(width =3,
                h3("Test"),
                helpText("Please Continent, Country and State Combition"),
                uiOutput("continent"),
                uiOutput("country")
            ),

            box(width =9,
                DT::dataTableOutput("table_subset")
            )
    )


  )
)

# Put them together into a dashboardPage
ui = dashboardPage(
  header,
  sidebar,
  body
)

################################################
################################################

server = shinyServer(function(input,output){

  data <- bind_rows(replicate(500, df, simplify = FALSE))




  # Showing the original data
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })



  # Creating filters
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = c(var_continent()), multiple = T)
  })
  output$country <- renderUI({
    selectInput(inputId = "Country", "Select Country",choices = c(var_country()), multiple = T)
  })



  # Cascasing filter for state

  var_continent <- reactive({
    file1 <- data
    country <- input$Country
    file2 <- country_function()

    if(is.null(country)){
      as.list(unique(file1$Continent))
    } else {
      as.list(c(unique(file2$Continent)))
    }

  })

  # Creating reactive function to subset data
  continent_function <- reactive({
    file1 <- data
    continent <- input$Continent
    continent <<- input$Continent

    if (is.null(continent)){
      return(file1)
    } else {
      file2 <- file1 %>% 
        filter(Continent %in% continent)
      return (file2)
    }


  })

  var_country <- reactive({
    file1 <- data
    continent <- input$Continent
    file2 <- continent_function()

    if(is.null(continent)){
      as.list(unique(file1$Country))
    } else {
      as.list(unique(file2$Country))
    }

  })

  country_function <- reactive({
    file1 <- data
    country <- input$Country
    country <<- input$Country

    if (is.null(country)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country)
      return (file2)
    }

  })




  df <- reactive({

    file1 <- data
    continent <- input$Continent
    country <- input$Country

    if (is.null(continent) & is.not.null(country)){
      file2 <- file1 %>%
        filter(Country %in% country)
    } else if (is.null(country) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Continent %in% continent)
    } else if (is.not.null(country) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Country %in% country, Continent %in% continent)
    } else if (is.null(continent) & is.null(country)){
      file2 <- NULL
    } else if (is.null(continent) & is.not.null(country)){
      file2 <- file1 %>%
        filter(Country %in% country)
    } else if (is.null(country) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Continent %in% continent)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country, Continent %in% continent)
    }
    file2
  })

  output$table_subset <- DT::renderDataTable({
    # validate(
    #   need(input$Continent, 'Check that'),
    #   need(input$Country, 'Please choose :)')
    #   need(input$State, 'Please choose :D')
    # )
    DT::datatable(df(), options = list(scrollX = T))

  })

})



############################ CODE ENDS HERE ###########################################

shinyApp(ui, server)

1 个答案:

答案 0 :(得分:1)

您的问题是,每当您更新输入字段时,输入都会设置为NULL

我通过使renderUI语句静态(仅运行一次)解决了您的问题。如果这不可能,您也可以将其放在isolate语句中。我添加了两个观察来更新选择选项。在这里,我还使用了一个小技巧来设置selected = input$Continent,这可以使当前选择始终解决您的问题。

 server = shinyServer(function(input,output,session){

  data <- bind_rows(replicate(500, df, simplify = FALSE))
  # Showing the original data
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })



  # Creating filters
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = unique(data$Continent), multiple = T)
  })
  output$country <- renderUI({
    isolate(
      selectInput(inputId = "Country", "Select Country",choices = unique(data$Country), multiple = T)
    )
  })

 observe(
   updateSelectInput(
     session = session,
     inputId = "Continent",
     choices = var_continent(),
     selected = input$Continent
   )
 ) 

 observe(
   updateSelectInput(
     session = session,
     inputId = "Country",
     choices = var_country(),
     selected = input$Country
   )
 ) 

  # Cascasing filter for state

    var_continent <- reactive({
    file1 <- data
    country <- input$Country
    file2 <- country_function()
    if(is.null(country)){
      as.list(unique(file1$Continent))
    } else {
      as.list(c(unique(file2$Continent)))
    }

  })

  # Creating reactive function to subset data
  continent_function <- reactive({
    file1 <- data
    continent <- input$Continent

    if (is.null(continent)){
      return(file1)
    } else {
      file2 <- file1 %>% 
        filter(Continent %in% continent)
      return (file2)
    }


  })

  var_country <- reactive({
    file1 <- data
    continent <- input$Continent
    file2 <- continent_function()

    if(is.null(continent)){
      as.list(unique(file1$Country))
    } else {
      as.list(unique(file2$Country))
    }

  })

  country_function <- reactive({
    file1 <- data
    country <- input$Country
    country <- input$Country

    if (is.null(country)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country)
      return (file2)
    }

  })




  df <- reactive({

    file1 <- data
    continent <- input$Continent
    country <- input$Country
    if (is.not.null(country)){
      file1 <- file1 %>%
        filter(Country %in% country)
    }

    if (is.not.null(continent)){
      file1 <- file1 %>%
        filter(Continent %in% continent)
    }
    file1
  })

  output$table_subset <- DT::renderDataTable({
    # validate(
    #   need(input$Continent, 'Check that'),
    #   need(input$Country, 'Please choose :)')
    #   need(input$State, 'Please choose :D')
    # )
    DT::datatable(df(), options = list(scrollX = T))

  })

})

希望这会有所帮助