忽略前置内容； prependContent 不能在 Shiny 渲染调用中使用

Question

我有一个闪亮的应用程序，其中有很多需要选择的点才能在表格中显示数据。我喜欢这个问题here中显示的功能。不幸的是，在闪亮中实现此操作会产生错误消息

Ignoring prepended content; prependContent can't be used in a Shiny render call

。我闪亮的应用程序相当大，需要内部数据，因此我将发布上述链接问题中的示例。如果有人可以让它在闪亮的情况下工作，我可以将其调整到我的应用程序。

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))

data_2<-data_2 %>%
  mutate(
    lab_DB = case_when(
      Name1 == unique(data_2$Name1)[1]  ~ "blue",
      Name1 == unique(data_2$Name1)[2]  ~ "green",
      Name1 == unique(data_2$Name1)[3]  ~  "red"
      
    )
  )


sdf <- SharedData$new(data_2, key=~ID, group="SharedDataqwertyui")


lmap <- leaflet() %>%
  addTiles() %>%
  addMarkers(data=sdf, group="test", layerId = ~ID) %>%
  htmlwidgets::prependContent(tags$script(src="https://unpkg.com/[email protected]/dist/leaflet-lasso.umd.min.js")) %>%
  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
         }")
    )
  ) 


dtable <- datatable(sdf , width = "100%",editable=TRUE, caption=tags$caption("Mean of Value1: ",summarywidget(sdf, statistic='mean', column='Value1')))

bscols( widths=c(6,6,0), lmap, dtable, htmltools::p(summarywidget(sdf, statistic='mean', column='Value1'), style="display:none;"))

Answer 1

您可以实现

lasso

问题中的示例给出的

shiny

选择，如下所示。

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

lassoPlugin <- htmlDependency(
  "Leaflet.lasso",
  "2.2.13",
  src = c(href = "https://unpkg.com/[email protected]/dist/"),
  script = "leaflet-lasso.umd.min.js"
)

registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}

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)
)

data_2 <- data_2 %>%
  mutate(lab_DB = case_when(
    Name1 == unique(data_2$Name1)[1]  ~ "blue",
    Name1 == unique(data_2$Name1)[2]  ~ "green",
    Name1 == unique(data_2$Name1)[3]  ~  "red"
  ))

sdf <- SharedData$new(data_2, key =  ~ ID, group = "SharedDataqwertyui")

ui <- fluidPage(leafletOutput("map"))

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(data = sdf,
                 group = "test",
                 layerId = ~ ID) %>%
      registerPlugin(lassoPlugin) %>%
      htmlwidgets::onRender("
        function(el, x) {

          setTimeout(() => {
            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;

          }, '50');
        }"
      ) %>%
      addEasyButton(
        easyButton(
          icon = "fa-ban",
          title = "Clear Selection",
          id = "clearbutton",
          onClick = JS("function(btn, map){
              return
         }")
        )
      )
  })
  
}

shinyApp(ui, server)