仅当使用 LayersControl 缩放级别 > 8 时才在 Shiny 中的传单地图中显示图层?

问题描述 投票:0回答:1

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

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

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

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)
javascript r shiny r-leaflet
1个回答
5
投票

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

这里有一个小解释:

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

textinput
或 sthg 并创建“检查元素”。您会看到闪亮的输入有一个 id,....标记输入没有

挑战 2:访问没有 id 的输入: (从这里开始,您应该知道如何从 JS 向 R 发送消息并返回:您可以在这里找到一篇非常好的文章:https://ryouready.wordpress.com/2013/11/20/sending-data-from-客户端到服务器和返回使用闪亮/) 如何访问输入:嗯,基本上就是通过谷歌找到正确的片段。最后是这样的:

document.getElementsByTagName("input")
。 (注意:从这里开始我假设你只有一个输入) 并且知道这会变得有点棘手。尝试访问 这个输入。通过
console.log()
,您可以打印到 javascript 控制台(并通过“F12”--> 控制台 (JS) 在正在运行的应用程序中打开它。) 您可以将此输入打印为 HtMLCollection 但无法访问它,这可能会非常令人困惑。

挑战 3:访问 HTMLCollection

无法访问的原因(简而言之)是在“DOM”构建之前调用了 JS 代码。如果在“

<body></body>
”之后调用脚本,那就完全没问题了。但对于普通的香草闪亮来说,这并不那么容易。您可以尝试
window.onload()
document.ready()
。 到目前为止对我来说最可靠的是使用: session$onFlushed() 并触发器将该函数内的 JSCode 从 R 发送到“JS”。 (然后通过
Shiny.onInputChange("marker", inputs[0].checked)
将值作为输入发送回 R;) --> 这将产生所需的“input$marker”。 然而,这个函数只触发一次,这是完全正确的行为。但当您单击该按钮时,您将不会获得更新。

挑战 4:更新输入$marker 好吧,漂亮的版本是有一个函数

.onclicked()
/输入监听器。也许有人可以找到解决方案。我在shiny中尝试了一种解决方法,我告诉shiny不断通过
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)
© www.soinside.com 2019 - 2024. All rights reserved.