仅在缩放级别>时在Shiny中的小册子地图中显示图层。 8与LayersControl?

时间:2017-01-15 21:35:38

标签: r shiny leaflet

我想仅在点击LayersControl时显示图层,并且缩放级别大于某个数字,例如8.其中一个原因是,必须执行一些昂贵的计算才能获得层坐标。我想使用layerscontrol而不是额外的输入按钮(出于光学原因)。

如果在layerscontrol中单击图层按钮,有没有办法检索该值?

这是一个简单的例子(不工作):

library(leaflet) 
library(shiny)

ui <- fluidPage(
  leafletOutput("map", width = "100%", height = "700")
)

server <- function(input, output){
  output$map <- renderLeaflet({
    leaflet() %>% addTiles() %>% setView(10.4, 50.3, 7) %>%
      addLayersControl(overlayGroups = c("marker"),
                       options = layersControlOptions(collapsed = FALSE))
  })

  observe({
   # if (input$marker == TRUE){ # how to get value if layercontrol is clicked?
      if (input$map_zoom > 8) {
        leafletProxy("map") %>% addMarkers(lng = 10.5, lat = 50, group = "marker")
      }
  #  }
  })
}

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:4)

这是第一个正在运行的版本。也许smdy想出了“清洁”:)。

这里有一个小小的解释:

挑战1:输入$ marker不存在为闪亮输入。 打开您的应用程序(在浏览器中),右键单击您感兴趣的标记输入,然后在浏览器中选择“检查元素”或等效标签。您将看到该输入的代码。 那么为什么你不能访问它。要查看有光泽的输入类型的差异,请创建textinput或sthg并创建“检查元素”。你看到闪亮的输入有一个id,....标记输入不是

挑战2:访问没有ID的输入: (从这里开始,您应该知道如何将消息从JS发送到R并返回:这里有一篇非常好的文章:https://ryouready.wordpress.com/2013/11/20/sending-data-from-client-to-server-and-back-using-shiny/) 如何访问输入:嗯,这基本上只是通过谷歌找到正确的片段。最后:document.getElementsByTagName("input")。 (注意:从这里我假设你只有一个输入) 并且知道它有点棘手。尝试访问 这个输入。通过console.log(),你可以打印到javascript控制台(并通过“F12” - &gt;控制台(JS)在正在运行的应用程序中打开它。) 您可以将此输入打印为HtMLCollection,但无法访问它,这可能非常令人困惑。

挑战3:访问HTMLCollection

为什么你不能访问它的原因是在构建“DOM”之前调用JS代码。如果在“<body></body>”之后调用脚本,它将完全正常工作。但这并不容易,普通的香草有光泽。您可以尝试window.onload()document.ready()。 到目前为止,最可靠的是使用: session $ onFlushed()并触发将该函数中的JSCode从R发送到“JS”。 (然后通过Shiny.onInputChange("marker", inputs[0].checked)将该值作为输入发送回R;) - &gt;这将产生所需的“输入$标记”。 但是,此功能仅触发一次,这是完全正确的行为。但是当你点击按钮时你不会有更新。

挑战4:更新输入$ marker 那个漂亮的版本将是一个函数.onclicked() /一个输入的监听器。也许有人可以找到解决方案。我尝试了一个闪亮的解决方法,我告诉闪亮通过autoInvalidate()不断获得输入的价值。

挑战5: 嗯,不是那么困难,因为它只是闪亮,但为了完整。根据问题中提供的代码,标记将在加载一次时保留。一旦不符合缩放标准,不确定是要保留还是要删除它。 无论如何,如果你想让它消失,%>% clearMarkers()就是你的朋友。

library(leaflet)
library(shiny)

getInputwithJS <- '
Shiny.addCustomMessageHandler("findInput",
  function(message) {
  var inputs = document.getElementsByTagName("input");
  Shiny.onInputChange("marker", inputs[0].checked);
}
);
'

ui <- fluidPage(

  leafletOutput("map", width = "100%", height = "700"),
  tags$head(tags$script(HTML(getInputwithJS)))
)

server <- function(input, output, session){
  global <- reactiveValues(DOMRdy = FALSE)
  output$map <- renderLeaflet({
    leaflet() %>% addTiles() %>% setView(10.4, 50.3, 7) %>%
      addLayersControl(overlayGroups = c("marker"),
                       options = layersControlOptions(collapsed = FALSE))
  })

  autoInvalidate <- reactiveTimer(1)

  observe({
    autoInvalidate()
    if(global$DOMRdy){
      session$sendCustomMessage(type = "findInput", message = "")      
    }
  })

  session$onFlushed(function() {
    global$DOMRdy <- TRUE
  })

  observe({
    if (!is.null(input$marker)){
      if (input$marker == TRUE){ # how to get value if layercontrol is clicked?
        if (input$map_zoom > 8) {
          leafletProxy("map") %>% addMarkers(lng = 10.5, lat = 50, group = "marker")
        }else{
          leafletProxy("map") %>% clearMarkers()
        }
      }
    }
  })
}

shinyApp(ui = ui, server = server)