javascript - How to add popupmovable plugin to a leaflet map? - Stack Overflow

admin管理员组

文章数量:1394094

I'm using R shiny to build a web application for users to plot past and present data. Many of these data points are close together, so when the user opens the popups, they overlap. The user needs all popups they want to be open at once to view the data from the station, and shift them so that they can view them at one time, save the map, and export it into a report.

I've tried adding in this java plugin, but to no success. I'm not very experienced with creating and adding plugins, have only done it a couple times for minor things, so I know that I am missing something, but cannot seem to figure it out. Below is some R script showing a small example of how I'm trying to use it.

library(leaflet)
library(leaflet.esri)
library(htmltools)
library(htmlwidgets)
library(shiny)
library(shinyjs)

data <-data.frame(lat=c(34.85,34.89,34.92,34.89),
                  lon=c(-72.89,-72.96,-72.95,-72.85),
                  station=c('1A','2A','3A','4A'),year=c(2017,2018,2019,2020))

addPopupMove = htmltools::htmlDependency("leaflet.PopupMovable","1.0.0",
                                         src = c(href = '.PopupMovable.js'),
                                         script = 'leaflet.PopupMovable.js')

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

ui =  fluidPage(
  tags$head(
    includeScript(".PopupMovable.js"),
    useShinyjs()),
  mainPanel(leafletOutput("map",width = 900,height = 600)))


server = shinyServer(function(input, output, session){

  map = function(){leaflet(options = leafletOptions(worldCopyJump = FALSE, preferCanvas = TRUE)) %>%
  setView(lng = 0,lat = 0,zoom = 2)%>%
  addEsriBasemapLayer(esriBasemapLayers$Oceans,
                      autoLabels = TRUE, 
                      options = providerTileOptions(noWrap = FALSE,updateWhenIdle = TRUE),
                      group = 'Oceans') %>% 
      addMarkers(lat = data$lat,lng = data$lon,
                 popup = paste(data$station,"<br>",
                               "Lat: ",data$lat,"<br>",
                               "Lon: ",data$lon,"<br>",
                               "Est.: ",data$year),
                 popupOptions = popupOptions(autoClose = FALSE, closeOnClick = FALSE))%>% 
      registerPlugin(addPopupMove)%>%
      onRender("function (el,x){
        var popmove = L.Map.PopupMovable(options = { popupMovable: true
             });
              popmove.addTo(this);
               ")
    }
  
  react_map = reactiveVal(map())
  output$map = renderLeaflet({react_map() })

})


shinyApp(ui,server)

The goal is to allow the user to click and drag the popups out of the way, but still have the lead lines to the marker.

I'm using R shiny to build a web application for users to plot past and present data. Many of these data points are close together, so when the user opens the popups, they overlap. The user needs all popups they want to be open at once to view the data from the station, and shift them so that they can view them at one time, save the map, and export it into a report.

I've tried adding in this java plugin, but to no success. I'm not very experienced with creating and adding plugins, have only done it a couple times for minor things, so I know that I am missing something, but cannot seem to figure it out. Below is some R script showing a small example of how I'm trying to use it.

library(leaflet)
library(leaflet.esri)
library(htmltools)
library(htmlwidgets)
library(shiny)
library(shinyjs)

data <-data.frame(lat=c(34.85,34.89,34.92,34.89),
                  lon=c(-72.89,-72.96,-72.95,-72.85),
                  station=c('1A','2A','3A','4A'),year=c(2017,2018,2019,2020))

addPopupMove = htmltools::htmlDependency("leaflet.PopupMovable","1.0.0",
                                         src = c(href = 'https://raw.githubusercontent/wrwrh/leaflet-popupmovable/refs/heads/main/leaflet.PopupMovable.js'),
                                         script = 'leaflet.PopupMovable.js')

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

ui =  fluidPage(
  tags$head(
    includeScript("https://raw.githubusercontent/wrwrh/leaflet-popupmovable/refs/heads/main/leaflet.PopupMovable.js"),
    useShinyjs()),
  mainPanel(leafletOutput("map",width = 900,height = 600)))


server = shinyServer(function(input, output, session){

  map = function(){leaflet(options = leafletOptions(worldCopyJump = FALSE, preferCanvas = TRUE)) %>%
  setView(lng = 0,lat = 0,zoom = 2)%>%
  addEsriBasemapLayer(esriBasemapLayers$Oceans,
                      autoLabels = TRUE, 
                      options = providerTileOptions(noWrap = FALSE,updateWhenIdle = TRUE),
                      group = 'Oceans') %>% 
      addMarkers(lat = data$lat,lng = data$lon,
                 popup = paste(data$station,"<br>",
                               "Lat: ",data$lat,"<br>",
                               "Lon: ",data$lon,"<br>",
                               "Est.: ",data$year),
                 popupOptions = popupOptions(autoClose = FALSE, closeOnClick = FALSE))%>% 
      registerPlugin(addPopupMove)%>%
      onRender("function (el,x){
        var popmove = L.Map.PopupMovable(options = { popupMovable: true
             });
              popmove.addTo(this);
               ")
    }
  
  react_map = reactiveVal(map())
  output$map = renderLeaflet({react_map() })

})


shinyApp(ui,server)

The goal is to allow the user to click and drag the popups out of the way, but still have the lead lines to the marker.

• javascript
• r
• shiny
• r-leaflet

Share Follow edited Mar 14 at 17:34 Jan 10.2k66 gold badges2121 silver badges3333 bronze badges asked Mar 14 at 15:00 MoodyMoody 2311 silver badge44 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

Your approach using includeScript() is suitable. Additionally one needs to set the popupMovable option to true to enable the plugin. This can be done without Javascript: If l is the leaflet() object, you can add

if (is.null(l$x$options)) l$x$options <- list()
l$x$options$popupMovable <- TRUE

library(leaflet)
library(leaflet.esri)
library(shiny)

data <- data.frame(
  lat = c(34.85, 34.89, 34.92, 34.89),
  lon = c(-72.89, -72.96, -72.95, -72.85),
  station = c('1A', '2A', '3A', '4A'),
  year = c(2017, 2018, 2019, 2020)
)

ui <- fluidPage(
  tags$head(
    includeScript(
      "https://raw.githubusercontent/wrwrh/leaflet-popupmovable/refs/heads/main/leaflet.PopupMovable.js")
    ),
  mainPanel(leafletOutput("map",width = 900,height = 600))
)

server <- function(input, output, session){
  map <- function(){
    l <- leaflet(
      options = leafletOptions(
        worldCopyJump = FALSE, 
        preferCanvas = TRUE)
      ) |> 
      setView(lng = 0,lat = 0,zoom = 2) |> 
      addEsriBasemapLayer(esriBasemapLayers$Oceans,
                          autoLabels = TRUE,
                          options = providerTileOptions(
                            noWrap = FALSE,
                            updateWhenIdle = TRUE
                          ),
                          group = 'Oceans') |> 
      addMarkers(lat = data$lat,lng = data$lon,
                 popup = paste(data$station,"<br>",
                               "Lat: ",data$lat,"<br>",
                               "Lon: ",data$lon,"<br>",
                               "Est.: ",data$year),
                 popupOptions = popupOptions(
                   autoClose = FALSE, 
                   closeOnClick = FALSE)
                 )
    
    if (is.null(l$x$options)) l$x$options <- list()
    l$x$options$popupMovable <- TRUE
    l
  }
  react_map = reactiveVal(map())
  output$map = renderLeaflet({react_map()})
}

shinyApp(ui, server)

本文标签： javascriptHow to add popupmovable plugin to a leaflet mapStack Overflow