How to can i add two different markers with two di

问题:

I am trying to add two different markers for two different inputs. I got the first one working but not for the second one. Here is my code

ui.R

library(shiny)
library(leaflet)


shinyUI(fluidPage(


  # Application title
  titlePanel("Aspen GBS Population Structure results on map"),

  # Side bar layout
  sidebarLayout(
    sidebarPanel(
      selectInput("structure", label = "Select K for display", choices = c("2", "3", "4", "5", "6"), selected = "2"),
      checkboxInput("origin", label = "Flood path")),

      mainPanel(
    leafletOutput("map")
      )
    )
  )
)

server.R

leafIcons <- icons(
  iconUrl = ifelse(data_K2$FP_Icon == "greenleafIcon",
                   "http://leafletjs.com/docs/images/leaf-green.png",
                   "http://leafletjs.com/docs/images/leaf-red.png"
  ),
  iconWidth = 38, iconHeight = 95,
  iconAnchorX = 22, iconAnchorY = 94,
  shadowUrl = "http://leafletjs.com/docs/images/leaf-shadow.png",
  shadowWidth = 50, shadowHeight = 64,
  shadowAnchorX = 4, shadowAnchorY = 62
)




library(shiny)


shinyServer(function(input, output, session) {
    dt <- reactive(
        switch(input$structure,
              "2" = data_K2$Structure.2,
              "3" = data_K2$Structure.3))

    output$map <- renderLeaflet(
      leaflet(data = data_K2) %>% addTiles() %>% setView(lng = -106.1039361,lat = 50.543981, zoom = 4) %>% 
      addCircleMarkers(lat = ~Lat, lng = ~Long, popup = ~Location_discription, radius=2, color = ~dt(), fill = TRUE) %>%
      addMarkers(lat = ~Lat, lng = ~Long, popup = ~Location_discription, icon = leafIcons)
    )
})

I want the addMarkers to get activated when i use the checkboxInput button only. But right now it is selected by default.

回答1:

I've found the easiest way is to label the markers with groups, then just show/hide them on input. That way you save some computation, and leaflet is designed to do this with leafletProxy (it's well documented on the Rstudio guide). You would need to add an observer as well that would update the map, as in this example,

library(shiny)
library(leaflet)

ui <- shinyUI(fluidPage(
    sidebarLayout(
        sidebarPanel(
            checkboxInput("show", "Show/Hide")
        ),
        mainPanel(
            leafletOutput("map")
        )
    )
))

dat <- data.frame(lng = rnorm(3, -106.1039361, 0.5) ,
                  lat = rnorm(3, 50.543981, 0.5))

server <- shinyServer(function(input, output, session) {

    ## Your map, give the markers groups
    output$map <- renderLeaflet(
        leaflet(data = dat) %>% 
        addTiles() %>% setView(lng = -106.1039361,lat = 50.543981, zoom = 4) %>% 
        addCircleMarkers(group="circles",
                         popup = ~paste(lat), radius=2, fill = TRUE) %>%
        addMarkers(group="markers")
    )

    ## Observer to update map on input
    observeEvent(input$show, {
        proxy <- leafletProxy('map')
        if (input$show) proxy %>% showGroup('markers')
        else proxy %>% hideGroup('markers')
    })
})

shinyApp(ui, server)