Search code examples
rshinyleafletshinydashboardselectinput

How to display map dynamically changed as per drilldown selectInput() based on previous selections?


enter image description here

I would like to render a map based on selectInput(). I have two selectInput()s: first one product_type and second one product_name. In the second one selectInput() the drop down options should be display only relevant to first selectInput(). Based on these drill down inputs map should change dynamically.

Here is the code:

ui <- shinyUI(dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      box("", 
          leafletOutput("abc", width = '100%', height = 300),
      
          height = 350, width = 12),
  
      box("", 
          selectInput('vtype', label = 'Prod Type',choices = brand$prod_type),
          selectInput('vname', label = 'Prod Name',choices = brand$prod_name),
          width = 4),
  
      valueBoxOutput("gr", width = 8)
  
    )
  )
))

server <- shinyServer(function(input,output,session){
  a <- ship %>% select(prod_name,prod_type,LON,LAT) %>% filter(prod_type == input$vtype)
  output$gr <- renderValueBox({
    box(table(a))
  })
  output$abc <- renderLeaflet({

      leaflet() %>% addProviderTiles(providers$OpenTopoMap ) 
%>% setView(lat = a$LAT ,lng = A$LON, zoom = 4)
  }) 

})

shinyApp(ui,server)

The dynamically changed points in the map should be marked up. I tried but could not able to build the code.

Any help on this code would be graceful for me.


Solution

  • I hope my example helps. I invented a data.frame 'ship' and made everything dependent on it. That means it is used for your variable 'brand' as well as 'ship'.

    I'm not sure how you envisioned the value box, so I put category and products in it.

    library(shiny)
    library(shinydashboard)
    library(dplyr)
    library(leaflet)
    
    ship <- data.frame(
        product_type = c("food","food","tool","tool","tool","accessories","accessories","lighting","lighting","lighting"),
        product_name=c("eggs", "bread","clamp","hammer","screw driver", "watch" ,"sun glases","LED","bulb","briquette"),
        LON=c(-61.783,2.632,47.395,20.068,44.563,17.544,-170.730,-65.167,136.189,50.562),
        LAT=c(17.078 ,28.163 ,40.430 ,41.143 ,40.534 ,-12.296 ,-14.318 ,-35.377 ,-24.973 ,26.019),
        stringsAsFactors = F)
    
    ui <- dashboardPage(
        dashboardHeader(),
        dashboardSidebar(collapsed = TRUE, disable = FALSE),
        dashboardBody(
            # fluidPage(
                box(
                    leafletOutput("abc", width = '100%', height = 300),
                    height = 350,
                    width = 12),
    
                box(
                    selectInput('vtype', label = 'Prod Type', choices = c("< select product type>"="", ship$product_type)),
                    selectInput('vname', label = 'Prod Name', choices = c("< select item>"="", ship$product_name)),
                    width = 4),
                
                valueBoxOutput("gr", width = 8)
            #)
        )
    )
    
    server <- shinyServer(function(input,output,session){
    
        a <- reactive({
            ship %>%
                select(product_name, product_type, LON, LAT) %>%
                filter(product_type %in% input$vtype)
        })
        
        output$gr <- renderValueBox({
            valueBox( input$vtype, paste(a()$product_name, collapse=' - ') )
        })
        
        observe({
            updateSelectInput(session, 
                              inputId='vname', 
                              choices = c("< select item>"="", a()$product_name ))
        })
        
        output$abc <- renderLeaflet({
            leaflet() %>% 
                addProviderTiles(providers$OpenTopoMap ) %>%
                setView(lng=0, lat=0, zoom = 1)
        }) 
        
        observe({
            selection <- a() %>% filter(product_name %in% input$vname)
            leafletProxy("abc") %>%
                flyTo(lat = selection$LAT,
                        lng = selection$LON,
                        zoom = 4)
        }) 
    })
    
    shinyApp(ui,server)
    

    Please provide example data next time.