如何點擊 R Leaflet 狀態轉到 url？

Question

賞金將在 6 天后到期。 回答這個問題有資格獲得+50聲望獎勵。 蒂姆想引起更多人對這個問題的關注：

真的很想知道如何使用傳單在點擊時指向一個單獨的 URL。 我預計它會在 onRender 函數中涉及某種 js 腳本。 謝謝！

我想構建一個地圖，當點擊某個州時，它將在新選項卡中打開一個超鏈接 url。 我一直在四處尋找答案，但不能完全讓它適用於 r 傳單。 我相信我需要在onRender編輯 json，但似乎我做得不對。

非常感謝！！

library(tidyverse)
library(tigris)
library(leaflet)

state <-
    states(
        cb = TRUE
    ) %>% 
    filter(STUSPS %in% c('CA', 'WA', 'MD')) %>% 
    mutate(win_url = 
        case_when(
            STUSPS == 'CA' ~ str_c('<a href=https://shiny.demog.berkeley.edu/alexramiller/kqed-evictions/>California Evictions</a>'), 
            STUSPS == 'WA' ~ str_c('<a href=https://evictions.study/washington/maps/summary.html>Washington Evictions</a>'), 
            STUSPS == 'MD' ~ str_c('<a href=https://evictions.study/maryland/report/baltimore.html>Maryland Evictions</a>')))

leaflet(state) %>% 
    addMapPane(name = "polygons", zIndex = 410) %>% 
    addMapPane(name = "maplabels", zIndex = 420) %>% # higher zIndex rendered on top
    htmlwidgets::onRender('function onclick(e) {
    window.open(e.target.feature.properties.win_url);
        }') %>% 
    addProviderTiles("CartoDB.PositronNoLabels") %>%
    addProviderTiles("CartoDB.PositronOnlyLabels", 
                   options = leafletOptions(pane = "maplabels"),
                   group = "map labels") %>%
    addPolygons(
        # label = ~'<a href="https://shiny.demog.berkeley.edu/alexramiller/kqed-evictions/">California Evictions</a>', # this is an option but not preferred
        fillOpacity = .5, 
        color = ~'Red', 
        stroke = TRUE, 
        weight = 1, 
        opacity = .5, 
        highlightOptions = highlightOptions(
                    color = "#ff4a4a", 
                    weight = 5,
                    bringToFront = TRUE
                    )
    ) 

Answer 1

使用單擊傳單標記的答案將您帶到 URL並循環通過，從addEventListener 使用 for 循環和傳遞值，似乎有效：

jsCode <- paste0('
 function(el, x, data) {
  var marker = document.getElementsByClassName("leaflet-interactive");
  for(var i=0; i < marker.length; i++){
    (function(){
      var v = data.win_url[i];
      marker[i].addEventListener("click", function() { window.open(v);}, false);
  }()); 
  }
 }
')

並運行

leaflet(state) %>% 
    addMapPane(name = "polygons", zIndex = 410) %>% 
    addMapPane(name = "maplabels", zIndex = 420) %>% 
     addProviderTiles("CartoDB.PositronNoLabels") %>%
     addProviderTiles("CartoDB.PositronOnlyLabels", 
                    options = leafletOptions(pane = "maplabels"),
                    group = "map labels") %>%
  addPolygons(
        fillOpacity = .5, 
        color = 'Red', 
        stroke = TRUE, 
        weight = 1, 
        opacity = .5, 
        highlightOptions = highlightOptions(
                    color = "#ff4a4a", 
                    weight = 5,
                    bringToFront = TRUE
                    )  
        )  %>%
  htmlwidgets::onRender(jsCode, data=state) 

我不得不重新調整狀態 URL

state <-
    states(
        cb = TRUE
    ) %>% 
    filter(STUSPS %in% c('CA', 'WA', 'MD')) %>% 
    mutate(win_url = 
        case_when(
            STUSPS == 'CA' ~ 'https://shiny.demog.berkeley.edu/alexramiller/kqed-evictions/', 
            STUSPS == 'WA' ~ 'https://evictions.study/washington/maps/summary.html', 
            STUSPS == 'MD' ~ 'https://evictions.study/maryland/report/baltimore.html'))