Shiny中实现Leaflet套索选择功能遇prependContent错误求助

问题背景 #

开发含大量点位的Shiny应用，需通过套索选择点位并在表格展示对应数据。参考套索选择功能实现时，出现错误提示：Ignoring prepended content; prependContent can't be used in a Shiny render call。

错误原因 #

在Shiny的renderLeaflet调用中使用htmlwidgets::prependContent加载外部脚本不符合Shiny的渲染逻辑，需调整脚本加载方式。

修正后的完整代码 #

library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)

# 准备数据
data_2 <- data.frame(
  ID = c(1:8),
  Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
  Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
  Value1 = c(12,43,54,34,23,77,44,22),
  Value2 = c(6,5,2,7,5,6,4,3),
  Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
  Lon = c(5, -3, -2, -1, 4, 3, -5, 0)
) %>%
  mutate(
    lab_DB = case_when(
      Name1 == unique(Name1)[1] ~ "blue",
      Name1 == unique(Name1)[2] ~ "green",
      Name1 == unique(Name1)[3] ~ "red"
    )
  )

# 定义Shiny应用
ui <- fluidPage(
  # 在页面头部加载leaflet-lasso脚本，替代prependContent
  tags$head(
    tags$script(src = "https://unpkg.com/leaflet-lasso@2.2.4/dist/leaflet-lasso.umd.min.js")
  ),
  titlePanel("Leaflet套索选择联动表格"),
  fluidRow(
    column(width = 6, leafletOutput("map")),
    column(width = 6, DTOutput("table"))
  )
)

server <- function(input, output, session) {
  # 创建共享数据对象
  sdf <- SharedData$new(data_2, key = ~ID, group = "SharedDataqwertyui")
  
  # 渲染地图
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(data = sdf, group = "test", layerId = ~ID) %>%
      htmlwidgets::onRender("
        function(el, x) {
          var sheet = window.document.styleSheets[0];
          sheet.insertRule('.selectedMarker { filter: hue-rotate(135deg); }', sheet.cssRules.length);

          var map = this;
          const lassoControl = L.control.lasso(options={'position':'topleft'}).addTo(map);

          function resetSelectedState() {
                map.eachLayer(layer => {
                    if (layer instanceof L.Marker) {
                        layer.setIcon(new L.Icon.Default());
                    } else if (layer instanceof L.Path) {
                        layer.setStyle({ color: '#3388ff' });
                    }
                });
            }
            function setSelectedLayers(layers) {
                resetSelectedState();
                let ids = [];

                layers.forEach(layer => {
                    if (layer instanceof L.Marker) {
                      layer.setIcon(new L.Icon.Default({ className: 'selected selectedMarker'}));
                    } else if (layer instanceof L.Path) {
                        layer.setStyle({ color: '#ff4620' });
                    }

                    ids.push(layer.options.layerId);
                });
                ct_filter.set(ids);
            }

            var ct_filter = new crosstalk.FilterHandle('SharedDataqwertyui');
            ct_filter.setGroup('SharedDataqwertyui');

            var ct_sel = new crosstalk.SelectionHandle('SharedDataqwertyui');
            ct_sel.setGroup('SharedDataqwertyui');

            map.on('mousedown', () => {
                ct_filter.clear();
                ct_sel.clear();
                resetSelectedState();
            });
            map.on('lasso.finished', event => {
                setSelectedLayers(event.layers);
            });

            lassoControl.setOptions({ intersect: true});

            var clearSel = function(){
                ct_filter.clear();
                ct_sel.clear();
                resetSelectedState();
            }

            document.getElementById('clearbutton').onclick = clearSel;
        }") %>%
      addEasyButton(
        easyButton(
          icon = "fa-ban",
          title = "Clear Selection",
          id = "clearbutton",
          onClick = JS("function(btn, map){ return; }")
        )
      )
  })
  
  # 渲染表格
  output$table <- renderDT({
    datatable(sdf, width = "100%", editable = TRUE, 
              caption = tags$caption("Mean of Value1: ", 
                                    summarywidget(sdf, statistic = 'mean', column = 'Value1')))
  })
}

shinyApp(ui, server)

关键修正点 #

• 移除htmlwidgets::prependContent，改用Shiny UI的tags$head加载leaflet-lasso脚本，避免渲染冲突。
• 将原静态代码重构为标准Shiny应用结构（UI+Server），适配Shiny的运行逻辑。
• 保留原套索选择、点位高亮、表格联动及清除选择的功能逻辑。

内容的提问来源于stack exchange，提问作者CCurtis