仅当缩放级别>时，才在闪亮的传单地图中显示图层8 层控制?

2022-01-12 00:00:00 r shiny leaflet javascript shinyjs

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

I want to show a layer only when its clicked in the LayersControl and the zoom level is greater than a certain number, e.g. 8. One of the reasons is, that some expensive computations must be performed to get the layer coordinates. I want to use the layerscontrol and not an extra input button (for optical reasons).

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

Is there a way to retrieve the value, if the layer button is clicked in the layerscontrol?

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

Here is a simple example (not working):

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)

推荐答案

这是第一个运行的版本.也许 smdy 想出了 sthg "cleaner" :).

Here is a first running version. Maybe smdy comes up with sthg "cleaner" :).

这里做个小解释:

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

Challenge 1: input$marker does not exist as shiny input. Open your app (in a browser), make a right click on the marker input you are interested in and select "Inspect Element" or the equivilant label in your browser. You will see the code of that input. So why cant you access it. To see the difference to the kind of input you know from shiny, create a textinput or sthg and make "inspect element" as well. You see that the shiny-inputs have an id,....the marker input does not

挑战 2:访问没有 id 的输入:(从这里开始，您应该知道如何将消息从 JS 发送到 R 并返回:您将在此处找到一篇非常好的文章:https://ryouready.wordpress.com/2013/11/20/sending-data-from-client-到服务器并返回使用闪亮/)如何访问输入:嗯，这基本上只是通过谷歌找到正确的片段.最后是:document.getElementsByTagName("input").(注意:从这里开始我假设你只有一个输入)并且知道这有点棘手.尝试访问这个输入.通过 console.log() 您可以打印到 javascript 控制台(并通过F12"-> 控制台 (JS) 在正在运行的应用程序中打开它.)您可以将此输入打印为 HtMLCollection，但不能访问它，这可能会非常混乱.

Challenge 2: Access input that does not have an id: (From here on you should know how to send messages from JS to R and back: A very good article you will find here: https://ryouready.wordpress.com/2013/11/20/sending-data-from-client-to-server-and-back-using-shiny/) How to access the input: Well, thats basically just finding the right snippet via google. In the end this: document.getElementsByTagName("input"). (Attention: From here on I assume you only have one input) And know it gets a bit tricky. Try to access this input. Via console.log() you can print to javascript console (and open it in the running app via "F12" --> Console (JS).) You can print this input as HtMLCollection but can not access it, which can be very confusing.

挑战 3:访问​​ HTMLCollection

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

The reason (in short) why you can not access it is that the JS code is called before the "DOM" is build. It would work totally fine if the script is called after "<body></body>". But thats not that easy with plain vanilla shiny. You can try window.onload() or document.ready(). What is the most reliable for me so far is to use: session$onFlushed() and trigger to send the JSCode within that function from R to "JS". (And then send the value as an input back to R via Shiny.onInputChange("marker", inputs[0].checked); ) --> This will produce the desired "input$marker". However, this function only fires once, which is totally right behaviour. But you wont have updates when you click the button.

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

Challenge 4: Update input$marker Well the pretty version would be to have a function .onclicked()/ a listener for the input. Maybe somebody could find a solution. I tried a workaround in shiny, that i tell shiny to constantly get value of the input via autoInvalidate().

挑战 5:好吧，没那么难，因为它只是有光泽，但为了完整性.鉴于问题中提供的代码，标记将在加载一次时保留.一旦不满足缩放标准，不确定是要保留还是删除它.无论如何，如果你想让它消失，%>% clearMarkers() 是你的朋友.

Challenge 5: Well, not that difficult, because it is shiny only, but for sake of completeness. Given the provided code in the question, the marker will stay when loaded once. Not sure if you want it to stay or to be removed once your zooming criteria is not met. Anyway, if you want it to disappear, %>% clearMarkers() is your friend.

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)

相关文章