简体   繁体   中英

Load data into a R shiny app depending on selectInput

I have an app which is supposed to show a map of the crop types of a certain district. The data are geometry data (.shp files) which I want to load after the district was choosen. Whether the data are loaded as sf objects by st_read() or from workspace I don't mind.

The user is supposed to make the choice of the district in the first tab by selectInput, then I want the data to be loaded, so that the district is shown on the map in the second tab. Here the user should be able to further choose a region ("Landkreis") from the district and the kind of crop ("Kultur") to be displayed.
I need to load the data after the choice was made because the data are too big to load all of them at once.

The problem is now that the data are just not loaded but I don't get any error message. Only the base map is displayed and the selectInput menus on the second tab are emtpy.

Any help would be appreciated.

Here is a (hopefully) reproducible example (without data):

library(shinydashboard)
library(leaflet)
library(tidyverse)
library(sf)

ui <- dashboardPage(
  dashboardHeader(title = "LAWA",titleWidth = 200),
  dashboardSidebar(width = 200,            
                   sidebarMenu(id = "sidebarmenu", style = "position: Scroll; overflow: visible",  
                               
                               menuItem("choose file ", tabName = "choice",icon = icon("wrench")),
                               menuItem("map", tabName = "map",icon = icon("envira")), 
                               
                               conditionalPanel(condition = 'input.sidebarmenu == "map"',
                                                div(id = "form",
                                                    tags$hr(), 
                                                    selectInput(inputId = "gewLandkreis1", label = "Landkreise", choices = NULL), 
                                                    selectInput(inputId = "Kultur1", label = "Kultur",choices = NULL) 
                                                )            
                               )
                   )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "choice",
              selectInput(inputId = "gewRBZ1", label = "Please choose a district", choices = c("Mittelfranken","Niederbayern","Oberbayern","Oberfranken","Oberpfalz","Schwaben","Unterfranken"), selected = "Mittelfranken"), 
      ),
      
      tabItem(tabName = "map",
              fluidRow(style = "background-color:#D3D3D3;",column(12,h3(textOutput(outputId = "RBZ_name"))),
              ),
              tags$br(),
               column(12,
                     box(title = "district map",solidHeader = T, width = 14,status = "primary",
                         leafletOutput("map1", width = "1050px", height = "750px"))),
              
      ) #  Tabitem
    ) #  tabItems
  ) #  DashboardBody
) #  ui

server <- function(input, output, session){
  
  Inv <- reactive({    # here I want to load the data depending on the district chosen. the districts name is in every file, e.g. Inv_2018_Oberbayern.Rdata
    req(input$RBZ1)   
    name <- gsub(" ","",paste("Inv_2018_",input$RBZ1,".shp"))  #  name of the file  
    data <- st_read(dsn = name) # load data from file as sf object with st_read
  })
  
  # include district name in heading
  output$RBZ_name<-renderText({
    req(input$RBZ1)
    paste0("land use and crop growth in: ",input$gewRBZ1)
    
  })
  
  # observe function for region (= Landkreis) depending on district chosen
  observe({
    req(input$RBZ1)
    choice_LK <-  unique(Inv()$`BEZ_KRS`) 
    updateSelectInput(session, "gewLandkreis1", "Landkreise", choices = sort(choice_LK))
    
  })
  
  # observe function for crop type (= Kategorie) depending on district chosen
  observe({
    req(input$RBZ1)
    choice_Kultur <- sort(unique(Inv()$`Kategorie`))
    updateSelectInput(session, "Kultur1", "Kultur", choices = choice_Kultur)
  })
  
  # fiter data depending on chosen region and crop type for map
  data_input <- reactive({
    Inv() %>%
      filter(BEZ_KRS == input$gewLandkreis1) %>%
      filter(Kategorie  == input$Kultur1)
  })
  
  # popup definition
  # map popup for crops
  mappopup_Kultur <- reactive({
    paste(sep = "<br/>",
          paste0("<i>Fruchtart: <i>", data_input()$`Art`),
          paste0("<i>Fläche [ha] <i>", data_input()$`flaeche`),
          paste0("<i>Code: <i>", data_input()$`Code`),
          paste0("<i>Gemeinde: <i>", data_input()$`BEZ_GEM`))
  })
  
  # make map1 with leaflet
  output$map1 <- renderLeaflet({
    
    # base map
    map1 <- leaflet() %>%
      addTiles(group = "street map") %>%
      addProviderTiles(provider = providers$OpenTopoMap, group = "topo map")
    
  })
  
  # observe function for crop type and region
  observe({
    
    factpal <- colorFactor("RdYlGn", data_input()$`Art`)
    
    leafletProxy("map1") %>%
      clearControls() %>%
      clearShapes() %>%
      setView(lng = mean(st_bbox(data_input())[c(1,3)]), lat = mean(st_bbox(data_input())[c(2,4)]), zoom = 11) %>%
      addPolygons(data = data_input(), layerId = data_input()$`Code`, color =  ~factpal(Art), opacity = 0.8,
                  popup = mappopup_Kultur()) %>%
      addLegend("bottomright", pal = factpal, values = data_input()$`Art`) %>%
      addLayersControl(baseGroups = c("street map", "topo map"),
                       options = layersControlOptions(collapsed = F)) 
    
  })
}
  
  shinyApp(ui = ui, server = server)

Could it possibly be that you are requiring something that doesn't exist? See below, if you change input$RBZ1 to input$gewRBZ1 it should load your files. Sweet app, btw!


  Inv <- reactive({    # here I want to load the data depending on the district chosen. the districts name is in every file, e.g. Inv_2018_Oberbayern.Rdata
    req(input$RBZ1) #should it be 'input$gewRBZ1'
    name <- gsub(" ","",paste("Inv_2018_",input$RBZ1,".shp"))  #  name of the file  
    data <- st_read(dsn = name) # load data from file as sf object with st_read
  })

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM