Search code examples
rshinyreactiver-leaflet

Controlling choices for reactive selectinput with other Selectinput


I have two select inputs in my shiny app and I am trying to make it so that the first selectinput controls the dataset for both the leaflet map and for the other select input. When the "time" selectinput is "Day", I want the choices for the "food" selectinput to be dfmorn$food and I want the map to reflect this change. Likewise for "Night", I want the "food" input to display dfnight$food, and the map to reflect. Currently neither the map, nor the "food" selectinput are reacting to the "food" selectinput.

library(leaflet)
library(shiny)
library(shinydashboard)
library(dplyr)

#Data Sample

longN <- c(-96.72363, -96.72880, -96.72700)
latN <- c(17.06167, 17.06200, 17.06170 )
nameN <- c("jim", "grant", "pablo")
foodN <- c("tacos", "burger", "elote")


dfnight <- data.frame(longN, latN, nameN, foodN)

longM <- c(-96.7261564, -96.7260505, -96.7259757)
latM <- c(17.0543072,17.0548387, 17.0553262)
nameM <- c("bob", "frank", "sue")
foodM <- c("memelas","tortas", "tacos")

dfmorn <- data.frame(longM, latM, nameM, foodM)
#icons

puestocolorsN = c ("tacos" = 'green',
                  "burger" = 'orange',
                  "elote" = 'red'
                  )

colorsN = puestocolorsN[dfnight$food]

iconsN <- awesomeIcons(icon = 'ios-close',
                      iconColor = 'black',
                      library = 'ion',
                      markerColor = unname(colors) )
puestocolorsM = c ("tacos" = 'green',
                   "memelas" = 'orange',
                   "tortas" = 'black')

colorsM = puestocolorsM[dfmorn$food]

iconsM <- awesomeIcons(icon = 'ios-close',
                       iconColor = 'black',
                       library = 'ion',
                       markerColor = unname(colorsM)  )

#ui 


ui <- fluidPage(
  titlePanel(title = "Street Food Oaxaca"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "time",
        label = "Select Time",
        choices = c("Day", "Night"),
        selected = "Day"
      ),
      # uiOutput("conditionalUI")
      selectInput(
        inputId = "food",
        label = "Type of Food",
        choices = unique(dfmorn$food),
        selected = dfmorn$food[1:5],
        multiple = TRUE)),
    mainPanel(h3("Map"), leafletOutput("map", width = "800", height = "600"))))

#server
server <- function(input, output, session){ 
  
  
  observeEvent(input$time, {
    
    reactive(
      if(input$time == "Day") {
        renderUI({
          SelectInput(
            inputId = "food",
            label = "Type of Food",
            choices = unique(dfmorn$food),
            selected = dfmorn$food[1:5],
            multiple = TRUE
          )
        })
      }else {
        renderUI({
          updateSelectInput(
            inputId = "food",
            label = "Type of Food",
            choices = unique(dfnight$food),
            multiple = TRUE
          )
          
        })
      } 
    )
  })
  dfmorn1 <- eventReactive(input$food, {
    dfmorn %>% dplyr::filter(food %in% input$food)
  })
  dfnight1 <- eventReactive(input$food, {
    dfnight %>% dplyr::filter(food %in% input$food)
  })
  
  
  observeEvent(input$time, {
    
    reactive(
      if(input$time == "Day") {
        output$map = renderLeaflet({
          leaflet(data = dfmorn1()) %>%
            setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
            addTiles() %>%
            addAwesomeMarkers(
              lng = ~long,
              lat = ~lat,
              icon = icons,
              label = ~as.character(dfmorn$name))
        })
      }else {
        output$map = renderLeaflet({
          leaflet(data = dfnight1()) %>%
            setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
            addTiles() %>%
            addAwesomeMarkers(
              lng = ~long,
              lat = ~lat,
              icon = icons,
              label = ~as.character(dfmorn$name)
          )
          
        })
      } 
    )
  })

      }
  

 #Run the application 
shinyApp(ui = ui , server = server)

Also still trying to figure out grouping the marker colors based on dfmorn$food and dfnight$food as discussed here: https://stackoverflow.com/questions/72410372/assigning-color-to-leaflet-awesomemarkers-based-on-chr-column


Solution

  • You had a few typos and incorrect way to update selectInput. Try this

    library(leaflet)
    library(shiny)
    library(shinydashboard)
    library(dplyr)
    
    #Data Sample
    
    longN <- c(-96.72363, -96.72880, -96.72700)
    latN <- c(17.06167, 17.06200, 17.06170 )
    nameN <- c("jim", "grant", "pablo")
    foodN <- c("tacos", "burger", "elote")
    
    
    dfnight <- data.frame(long=longN, lat=latN, name = nameN, food=foodN)
    
    longM <- c(-96.7261564, -96.7260505, -96.7259757)
    latM <- c(17.0543072,17.0548387, 17.0553262)
    nameM <- c("bob", "frank", "sue")
    foodM <- c("memelas","tortas", "tacos")
    
    dfmorn <- data.frame(long=longM, lat=latM, name = nameM, food=foodM)
    
    puestocolorsN = c ("tacos" = 'green',
                       "burger" = 'orange',
                       "elote" = 'red'
    )
    
    colorsN = puestocolorsN[dfnight$food]
    
    iconsN <- awesomeIcons(icon = 'ios-close',
                           iconColor = 'black',
                           library = 'ion',
                           markerColor = unname(colorsN) )
    puestocolorsM = c ("tacos" = 'green',
                       "memelas" = 'orange',
                       "tortas" = 'black')
    
    colorsM = puestocolorsM[dfmorn$food]
    
    iconsM <- awesomeIcons(icon = 'ios-close',
                           iconColor = 'black',
                           library = 'ion',
                           markerColor = unname(colorsM)  )
    
    #ui
    ui <- fluidPage(
      titlePanel(title = "Street Food Oaxaca"),
      sidebarLayout(
        sidebarPanel(
          selectInput(
            inputId = "time",
            label = "Select Time",
            choices = c("Day", "Night"),
            selected = "Day"
          ),
          # uiOutput("conditionalUI")
          selectInput(
            inputId = "food",
            label = "Type of Food",
            choices = unique(dfmorn$food),
            selected = dfmorn$food[1:5],
            multiple = TRUE)),
        mainPanel(h3("Map"), leafletOutput("map", width = "800", height = "600")))
    )
    
    #server
    server <- function(input, output, session){
    
      observeEvent(input$time, {
    
        if(input$time == "Day") choices <- unique(dfmorn$food)
        else choices <- unique(dfnight$food)
    
          updateSelectInput(
            inputId = "food",
            label = "Type of Food",
            choices = choices,
            select=choices[1:3]
          )
      })
    
      dfmrn <- eventReactive(input$food, {
        if(input$time == "Day") df <- dfmorn
        else df <- dfnight
        df %>% dplyr::filter(food %in% input$food)
      })
    
      observe({print(dfmrn())})
    
      output$map = renderLeaflet({
        req(dfmrn())
        leaflet(data = dfmrn()) %>%
          setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
          addTiles()
      })
    
      observeEvent(input$food, {
        if(input$time == "Day") icons <- iconsM
        else icons <- iconsN
        popup <- paste( "<b>Name:</b>", dfmrn()$name,  "<br>",  "<b>Type of food:</b>", dfmrn()$food)
        leafletProxy("map", session) %>%
          clearShapes() %>%
          clearMarkers() %>%
          addAwesomeMarkers(
            data = dfmrn(),
            lng = ~long,
            lat = ~lat,
            icon = icons, popup = popup,
            label = ~as.character(name)
          )
      })
    
    }
    
    #Run the application
    shinyApp(ui = ui , server = server)