Coder Social home page Coder Social logo

trafficonese / leaflet.extras2 Goto Github PK

View Code? Open in Web Editor NEW
83.0 6.0 19.0 6.54 MB

Extra functionality for leaflet R package.

Home Page: https://trafficonese.github.io/leaflet.extras2/

License: GNU General Public License v3.0

R 37.32% JavaScript 60.15% CSS 2.53%
rstats leaflet leaflet-plugins geospatial data-visualization geospatial-visualization

leaflet.extras2's Introduction

leaflet.extras2

cran checks CRAN RStudio mirror downloads CRAN Downloads Lifecycle: maturing R build status AppVeyor build status Codecov test coverage

The goal of leaflet.extras2 package is to provide extra functionality to the leaflet and leaflet.extras R packages using various leaflet plugins.

Installation

For CRAN version

install.packages('leaflet.extras2')

For latest development version

remotes::install_github('trafficonese/leaflet.extras2')

Progress

Plugins integrated so far ...

If you need a plugin that is not already implemented create an issue. See the FAQ section below for details.

Documentation

The R functions have been documented using roxygen, and should provide enough help to get started on using a feature. However some plugins have lots of options and it's not feasible to document every single detail. In such cases you are encouraged to check the plugin's documentation.

Currently there are no vignettes (contributions welcome), but there are plenty of examples available.

FAQ

I want to use a certain leaflet plugin not integrated so far.

  • Good Solution: Create issues for plugins you wish incorporated but before that search the existing issues to see if issue already exists and if so comment on that issue instead of creating duplicates.
  • Better Solution: It would help in prioritizing if you can include additional details like why you need the plugin, how helpful will it be to everyone etc.
  • Best Solution: Code it yourself and submit a pull request. This is the fastest way to get a plugin into the package. Checkout this little tutorial.

I submitted an issue for a plugin long time ago but it is still not available.

This package is being developed purely on a voluntary basis on spare time without any monetary compensation. So the development progress can stall at times. It may also not be possible to prioritize one-off requests that no one else is interested in. Getting more people interested in a feature request will help prioritize development. Other option is to contribute code. That will get you added to the contributor list.

I found a bug.

  • Good Solution: Search existing issue list and if no one has reported it create a new issue.
  • Better Solution: Along with issue submission provide a minimal reproducible code sample.
  • Best Solution: Fix the issue and submit a pull request. This is the fastest way to get a bug fixed.

Code of Conduct

Please note that this project is released with a Contributor Code of Conduct. By participating in this project you agree to abide by its terms.

leaflet.extras2's People

Contributors

gadenbuie avatar jeffreyhanson avatar steffenoppel avatar trafficonese avatar

Stargazers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

Watchers

 avatar  avatar  avatar  avatar  avatar  avatar

leaflet.extras2's Issues

Pulse Icon

The original leaflet.extras has been abandoned and it advises not to use it. Could you implement the pulseIcon that is in that package into yours?

Changing the moveable marker icons and colours in addPlayback()

Hi, I am using the addPlayback() function. I would like to alter the moveable marker icons and colours so that each moveable marker is a different colour for each listed feature when the data supplied are a listed feature collection, e.g. as in the given example:

data <- sf::st_as_sf(leaflet::atlStorms2005[1:5,])
data$Name <- as.character(data$Name)
data <- st_cast(data, "POINT")
data$time <- unlist(lapply(rle(data$Name)$lengths, function(x) {
  seq.POSIXt(as.POSIXct(Sys.Date()-2), as.POSIXct(Sys.Date()), length.out = x)
}))
data$time <- as.POSIXct(data$time, origin="1970-01-01")
data$label <- paste0("Time: ", data$time)
data$popup = sprintf("<h3>Customized Popup</h3><b>Name</b>: %s<br><b>Time</b>: %s",
                     data$Name, data$time)
data <- split(data, f = data$Name)

Is it possible to alter the moveable marker icon and colours using javascript under playbackOptions? E.g. delving into this example: http://leafletplayback.theoutpost.io/examples/example_2.js I was expecting something like the below using htmlwidgets::JS but it is not working, and I am probably doing something wrong not being a js expert. Note, I can alter the icons using the icon argument, but that only worked for one icon type across all the features.

leaflet() %>%
    addTiles() %>%
    addPlayback(data = data,
    options = playbackOptions(
          marker =  htmlwidgets::JS(
                 "
                 function() {
                      return L.AwesomeMarkers(
                            {
                             prefix: 'fa',
                             icon: 'bullseye',
                             markerColor: 'green'
                             }
                      );
                  }
                  "
            )
      )
)

Any help greatly appreciated....

Overlaying sidebar using shinydashboard and addSidebar

Hi,

my problem is not easy to describe but I will do my best.

I use golem for a modularized shiny app, and within app_ui.R I define a sidebar:

 , sidebar = shinydashboardPlus::dashboardSidebar(
        
        shinydashboard::sidebarMenu(
          
          id = "mainSidebar", ...)

Now, I would like to integrate a shinydashboard::menuItem() with a leaflet map having its own sidebar. For testing, I used the build-in leaflet.extras2::addSidebar() example which can be found via:

paste0(system.file("examples", package = "leaflet.extras2"),
              "/sidebar_app.R")

In the result, the leaflet sidebar overlays the dashboard sidebar (mainSidebar), even if I use a different id for the leaflet sidebar, e.g. leaflet.extras2::sidebar_tabs(id = ns("mysidebarid"), ...) .

sidebar

Within the help page of leaflet.extras2::sidebar_pane() I find

Value
A shiny.tag with sidebar-specific HTML classes

, and I think, that is the problem. But how can I solve this?

Blank WMS Pop Up

Hello,

I'm trying to load some data on wetland areas into a Leaflet map and enable a popup when clicking various parts of the layer. I have studied the WMS XML file and I believe it's queryable, so I thought I would be able to implement this functionality with leaflet.extras2::addWMS(). I've included below a short code snippet showing what I'm up to. I was wondering if I've done something wrong or whether there's an issue with addWMS()? When I use the below code the pop up box is always empty.

NB. Please be patient for the map to load...the WMS server is pretty slow!

leaflet() %>%
            leaflet.extras2::addWMS(baseUrl = "https://environment.data.gov.uk/spatialdata/ramsar-england/wms", layers = "Ramsar_England", options = WMSTileOptions(
                                        transparent = TRUE,
                                        format = "image/png",
                                        info_format = "text/html")) %>% 
            setView(lng = -1.8, lat = 52.0, zoom = 5) 

Here's a link to the WMS XML data.

Spinner does not appear in Shiny application

I have wrapped the example for ?addSpinner into an R Shiny application., but the spinner does not appear.

Here is a reproducible example based on the example given for ?addSpinner. I expected a spinner to appear during the 'sleep' phase, but no spinner appears.

library(shiny)
library(leaflet)
library(leaflet.extras2)
library(magrittr)

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

sleep <- function(map){
  Sys.sleep(5)
  map
}

server <- function(input, output){
  output$leaf <- 
    renderLeaflet({
      leaflet(data = quakes) %>%
        addTiles()  %>%
        addSpinner() %>%
        startSpinner(options = list("lines" = 7, "length" = 20)) %>%
        sleep() %>%
        addMarkers(~long, ~lat, popup = ~as.character(mag), label = ~as.character(mag)) %>%
        stopSpinner()
    })
}

shinyApp(ui, server)

airDatePickerInput (ShinyWidgets) not rendering properly in leaflet sidebar menu

Placing an airDatePickerInput in a leaflet sidebar menu results in a blank box that does not respond when clicked. Reprex shown below:

library(sf)
library(shiny)
library(leaflet)
library(leaflet.extras2)
library(shinyWidgets)

data(breweries91, package = "leaflet")

ui <- fluidPage(
  h4("Leaflet Sidebar Plugin"),
  airDatepickerInput(
    inputId = "airdatepickerTEST2",
    label = "Correctly Working airDatePickerInput",
    timepicker = TRUE,
    timepickerOpts = timepickerOptions(
      timeFormat = "HH:mm"
    )
  ),
  splitLayout(
    cellWidths = c("27%", "73%"),
    tagList(
      actionButton("open", "Open Sidebar"),
      actionButton("close", "Close Sidebar"),
      actionButton("clear", "Clear Sidebar")
   ),
    tagList(
      leafletOutput("map", height = "700px", width = "100%"),
      ## Sidebar 1 #############
      sidebar_tabs(id = "mysidebarid",
        list(icon("car")),
        ## Sidebar 1 - Pane #############
        sidebar_pane(
          title = "home", id = "home_id", icon = icon("home"),
          tagList(
            airDatepickerInput(
              inputId = "airdatepickerTEST",
              label = "Not Working airDatePickerInput",
              timepicker = TRUE,
              timepickerOpts = timepickerOptions(
                timeFormat = "HH:mm"
              )
            ),
            sliderInput("obs", "Number of observations:",
                        min = 1, max = 32, value = 10),
            sliderInput("opa", "Point Opacity:",
                        min = 0, max = 1, value = 0.5),
            sliderInput("fillopa", "Fill Opacity:",
                        min = 0, max = 1, value = 0.2),
            dateRangeInput("daterange4", "Date range:",
                           start = Sys.Date() - 10,
                           end = Sys.Date() + 10),
            verbatimTextOutput("tab1")
          )
        )
      )
    )
  )
)

## Server ############
server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      ## Add Controls on all sides #########
      addEasyButton(easyButton(position = "topleft",
        icon = htmltools::span(class = "star", htmltools::HTML("&starf;")),
        onClick = JS("function(btn, map){ map.setZoom(1);}"))) %>%
      addEasyButton(easyButton(position = "topright",
        icon = htmltools::span(class = "star", htmltools::HTML("&starf;")),
        onClick = JS("function(btn, map){ map.setZoom(2);}"))) %>%
      addEasyButton(easyButton(position = "bottomright",
        icon = htmltools::span(class = "star", htmltools::HTML("&starf;")),
        onClick = JS("function(btn, map){ map.setZoom(3);}"))) %>%
      addEasyButton(easyButton(position = "bottomleft",
        icon = htmltools::span(class = "star", htmltools::HTML("&starf;")),
        onClick = JS("function(btn, map){ map.setZoom(4);}"))) %>%
      ## Add Sidebar ##########
      addSidebar(
        id = "mysidebarid",
        options = list(position = "left")
      )
  })
  
}
shinyApp(ui, server)

"addHexbin" in leaflet.extras2 doesn't allow for mean/sum

Using "addHexbin" in leaflet.extras2 only counts the number of records in each hexbin but there are many use cases for the mean, sum or other calculations within the hexbin. For example a dataset that is a list of species and the abundance of each species. Instead of a count of the number of times a species appears in each hexbin it would be useful to have the total or average abundance in a hexbin. In the example below there is no way to account for or access the abun column when using addHexbin.

library(leaflet)
  library(leaflet.extras2)
  
  n <- 100000
  df <- data.frame(lat = rnorm(n, 42.0285, .01),
                   lng = rnorm(n, -93.65, .01),
                   abun = rnorm(n, 20000, 1000))
  
  leaflet(df)  %>%
    addTiles() %>%
    addHexbin(lng = ~lng, lat = ~lat,
              options = hexbinOptions(
                colorRange = c( "purple","blue","green", "yellow"),
                radiusRange = c(1, 20)
              )) 

leaflet.extra2 addSidebyside does not display basemap when is embedded in R Markdown

Hi @trafficonese. First off, I would like to say thank you for all your effort in the development of this amazing package! 👏 👏

Description:
When creating a Markdown file (.Rmd) that embeds a leaflet map that uses addSidebyside the basemap (e.g. addTiles & addProviderTiles) does not appear.

To Reproduce

reproducible example

---
title: "demo_01"
author: "csaybar"
date: "12/17/2020"
output: html_document
---

```{r}
library(sp)
library(leaflet)
library(leaflet.extras2)

leaflet(quakes) %>%
  addMapPane("left", zIndex = 0) %>%
  addMapPane("right", zIndex = 0) %>%
  addTiles(group = "base", layerId = "baseid",
           options = pathOptions(pane = "right")) %>%
  addProviderTiles(providers$CartoDB.DarkMatter, group="carto", layerId = "cartoid",
                   options = pathOptions(pane = "left")) %>%
  addCircleMarkers(data = breweries91[1:15,], color = "blue", group = "blue",
                   options = pathOptions(pane = "left")) %>%
  addCircleMarkers(data = breweries91[15:20,], color = "yellow", group = "yellow") %>%
  addCircleMarkers(data = breweries91[15:30,], color = "red", group = "red",
                   options = pathOptions(pane = "right")) %>%
  addLayersControl(overlayGroups = c("blue","red", "yellow")) %>%
  addSidebyside(layerId = "sidecontrols",
                rightId = "baseid",
                leftId = "cartoid")

Expected behavior
Display the basemaps and the sidebar when the leaflet map is embedded in R Notebook files.

image

When I run the example before in R no problems appear :)

image

Relevant additional information about the system

R version 4.0.2 (2020-06-22)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.10

Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=de_AT.UTF-8
[4] LC_COLLATE=en_US.UTF-8 LC_MONETARY=de_AT.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=de_AT.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=de_AT.UTF-8 LC_IDENTIFICATION=C

attached base packages:
[1] stats graphics grDevices utils datasets methods base

other attached packages:
[1] leaflet.extras2_1.1.0.9000 leaflet_2.0.3 sp_1.4-4

loaded via a namespace (and not attached):
[1] rstudioapi_0.11 magrittr_1.5 knitr_1.30 lattice_0.20-41
[5] R6_2.5.0 rlang_0.4.8 fansi_0.4.1 tools_4.0.2
[9] grid_4.0.2 pkgbuild_1.1.0 xfun_0.18 tinytex_0.26
[13] cli_2.1.0 withr_2.3.0 crosstalk_1.1.0.1 htmltools_0.5.0
[17] remotes_2.2.0 yaml_2.2.1 digest_0.6.27 assertthat_0.2.1
[21] rprojroot_1.3-2 crayon_1.3.4 processx_3.4.4 callr_3.5.1
[25] htmlwidgets_1.5.2 ps_1.4.0 curl_4.3 glue_1.4.2
[29] evaluate_0.14 rmarkdown_2.5.2 compiler_4.0.2 leaflet.providers_1.9.0
[33] backports_1.1.10 prettyunits_1.1.1 jsonlite_1.7.1

Relevant additional information about the browser

  • Version 1.17.75 Chromium: 87.0.4280.88 (Official Build) (64-bit)
  • Version 84.0 (64-bit) Firefox

There are no errors appearing in the browser console.
image

Processing data for addVelocity

I'm not sure this is a leaflet.extras2 issue, but I thought I'd start here. I'm trying to add wind data to a leaflet map. I download the data using the following link,

https://nomads.ncep.noaa.gov/cgi-bin/filter_gfs_1p00.pl?file=gfs.t06z.pgrb2.1p00.f000&lev_10_m_above_ground=on&var_UGRD=on&var_VGRD=on&subregion=&leftlon=-72.74273&rightlon=-67.92787&toplat=43.64460&bottomlat=40.04384&dir=%2Fgfs.20201229%2F06

Then I convert the grib file to json using the weacast-grib2json program,

grib2json -d -n -o gfs.t06z.pgrb2.1p00.f000 gfs.t06z.pgrb2.1p00.f000.json

Basically following the guidance found here and here.

However, when I display the wind data on my leaflet map,

leaflet() %>%
    setView(lng = -70.3361, lat = 41.8451, zoom = 10) %>%
    addProviderTiles(providers$Esri.WorldImagery) %>%
    addVelocity(content = 'gfs.t06z.pgrb2.1p00.f000.json')

it looks different than what is displayed on windy or earth (the angle of the particles looks off). Not sure what is going on...

Windy

windy

vs. mine

manual

Maybe it's a projection issue?

Feature request: movingMarker

This person asked in the leaflet thread (to no reply), but I thought this would be a great addition to this package:
see here for details.

His request is basically to add the movingMarker feature to leaflet R. For me, I would like to use this for a shiny app where I am streaming in live GPS data. Currently I use the leafletProxy update in 10 increments when each coordinate comes in, but it still looks clunky. This would give a much smoother visual effect.

Implementation of Labelgun Plugin

Hi,
thank you very much for all the work you've put in leaflet extras 2 so far.
I think it would be great to implement the Labelgun Plugin
It avoids the collision of labels, if labels are always shown.
Personally, I would use it for city map designs when a lot of markers are in a relatively small place.
I believe it would be of use to anyone who wishes to always show certain marker attributes, e.g. the names of places.

Time Slider

Hi,
just found your package here on Github.
We're currently working with movement data (including timestamps). I was just wondering, if you have any plans to integrate one of these "Time Slider" Plugins. This would be a cool feature to use in our analysis
Cheers, Christoph

Issues with adding wind data to AddVelocity() in leaflet.extras2

Hi, I am trying to use the AddVelocity function in the leaflet.extras2 package in R so that I can add wind velocity visualization data to my leaflet map. I have found JSON u and v wind data from NOAA, but I cant seem to successfully add my wind velocity data using the content=. Any suggestions on how to format the json data so that AddVelocity can process it into an animation? The code below runs in R, but no wind arrows or animation is produced, just the base map appears. Any help would be much appreciated!

content<-"https://pae-paha.pacioos.hawaii.edu/erddap/griddap/ncep_global.json?ugrd10m%5B(2020-06-16T12:00:00Z)%5D%5B(-23.5):(80.0)%5D%5B(219.0):(323.5)%5D&.draw=surface&.vars=longitude%7Clatitude%7Cugrd10m&.colorBar=%7C%7C%7C%7C%7C&.bgColor=0xffccccff"

leaflet() %>%
addTiles(group = "base") %>%
setView(-71,42,5) %>%
leaflet.extras2::addVelocity(content =content ,group = "velo", layerId = "veloid")

Site with wind data :https://pae-paha.pacioos.hawaii.edu/erddap/griddap/ncep_global.graph?tmpsfc[(2011-05-07T00:00:00Z)][(34.625):(46.875)][(283.125):(295.375)],tmp2m[(2011-05-07T00:00:00Z)][(34.625):(46.875)][(283.125):(295.375)]&.draw=vectors&.vars=longitude%7Clatitude%7Ctmpsfc%7Ctmp2m&.color=0x000000&.bgColor=0xffccccff

"CurrentSize" for sizeModes in easyprintMap not working

Hi, thank's a lot for your work (that deserve more visibility given the time i spent to find it) !

However, i get an empty png when I use the "CurrentSize" option in an external Shiny button with easyprintMap.
The "CurrentSize" option is mention in help of easyprint.R but it seems that there is also the "Current" option. Moreover, it is the "Current" option that work in the easyprintOptions of addEasyprint.

line 95

#' @param sizeModes Options available include \code{CurrentSize}, \code{A4Portrait},
#' \code{A4Landscape} or a custom size object

line 119

sizeModes = list("A4Portrait", "A4Landscape", "Current"),

So i tried to use the "Current" option in easyprintMap but when i hits the button print the app freeze ... Not shure if it is just me or a real bug and not shure how to fix it so i lets this example below which is a sligthly modify version of your help example.

library(shiny)
library(leaflet)
library(leaflet.extras2)

ui <- fluidPage(
    leafletOutput("map"),
    selectInput("scene", "Select Scene", choices=c("Current",
                                                   "A4Landscape",
                                                   "A4Portrait")),
    actionButton("print", "Print Map")
)

server <- function(input, output, session) {
    output$map <- renderLeaflet({
        input$print
        leaflet()  %>%
            addTiles() %>%
            setView(10, 50, 9) %>%
            addEasyprint(options=easyprintOptions(
                             sizeModes=c("Current",
                                         "A4Landscape",
                                         "A4Portrait"),
                             exportOnly=TRUE
                         ))
    })
    observeEvent(input$print, {
        leafletProxy("map") %>%
            easyprintMap(sizeModes=input$scene)
    })
}

shinyApp(ui, server)

Thank's by advance

Disable WMS getFeatureInfo popup

I am trying to disable the getFeatureInfo pop-up in addWMS from the WMS plugin. In the original plugin page, there is a mention of a options.identify option that can be set to FALSE, however I have not found out how to do this in the leaflet.extras2 plugin. Is it possible to disable it in R? Thank you for your help!

Implement search for circle markers

Leaflet.extras has a search feature which currntly only works with markers. A edit of the lfx-search-prod.js file allows the search feature to also work with circle makers. However, this makes it hard to publish or share code. Would it be possible to enable this change in leaflet.extras2? This can be really useful when there are a large number of points or points over a wide area.

Problems with getFeatureInfo

Hallo trafficonese,

I had been very happy when i found your plugin for leaflet which enables to retrieve the feature info from a wms when clicking on some feature of a wms layer.
It worked perfectly when I tested this in my local RStudio environment. But -
when I upload the app to my productive server (where shiny server is configured to run behind an apache proxy) I get blank popups instead of the feature information.
This is my simplified code for testing (you can try it here: https://floraweb.de/shiny/wmstest):

library(leaflet)
library(leaflet.extras)
library(leaflet.extras2)
library(shiny)

ui <- fluidPage(
  leafletOutput("myMap", height = "600"))

server <- function(input, output, session) {
  output$myMap <- renderLeaflet(leaflet() %>% 
                    setView(lng=10,lat=51.2, zoom = 6) %>% addTiles(group = "OSM") %>%
                    addProviderTiles(providers$OpenTopoMap, group = "Topo") %>%
                    addProviderTiles(providers$Esri.WorldImagery, group = "ESRI Sat") %>%
                    addWMS(baseUrl = "http://geodienste.bfn.de/ogc/wms/schutzgebiet?",
                           group="NP",
                           layers = "Nationalparke",
                           options = WMSTileOptions(format="image/png",transparent=TRUE,opacity=0.7,info_format = "text/html",tiled = FALSE),
                           attribution = "Overlaykarten: (c) Bundesamt für Naturschutz (BfN) 2015") %>%
                    addWMS(baseUrl = "http://geodienste.bfn.de/ogc/wms/schutzgebiet?",
                           group="BSR",
                           layers = "Biosphaerenreservate",
                           options = WMSTileOptions(transparent = TRUE,opacity=0.7,format = "image/png",info_format = "text/html",tiled = FALSE),
                           attribution = "Overlaykarten: (c) Bundesamt für Naturschutz (BfN) 2015" ) %>%
                    addWMS(baseUrl = "http://geodienste.bfn.de/ogc/wms/gliederungen?",
                           group="RGL",
                           layers = "Naturraeume",
                           options = WMSTileOptions(format="image/png",transparent=TRUE,opacity=0.7,info_format = "text/html",tiled = FALSE),
                           attribution = "Overlaykarten: (c) Bundesamt für Naturschutz (BfN) 2015" ) %>%
                    addWMS(baseUrl = "http://sg.geodatenzentrum.de/wms_vg250-ew?",
                           group="VG250",
                           layers = "vg250_krs",
                           options = WMSTileOptions(format="image/png",transparent=TRUE,opacity=0.7,info_format = "text/html",tiled = FALSE),
                           attribution = "Overlaykarte: (c) Bundesamt für Kartographie und Geodäsie (BKG) 2014" ) %>%
                    addLayersControl(
                          baseGroups = c("OSM", "Topo", "ESRI Sat"),
                          overlayGroups = c("NP","BSR","RGL","VG250"),
                          options = layersControlOptions(collapsed = TRUE)) %>%
                    hideGroup("NP") %>% hideGroup("BSR") %>% hideGroup("RGL") %>% hideGroup("VG250") %>%
                    addResetMapButton()
        )
}
shinyApp(ui, server)

I would be very happy if you could help to find out what might be the reason for this (I have read the issue #4, but this did'nt put me on the right track...

awesomeIcons in addMovingMarker for direction

Hello!
I'm using great function from your project addMovingMarker. It works fine. But I'm trying to use makeAwesomeIcon instead of makeIcon, because it's important for me to rotate icon during visualization.
Is it possible to do it with makeAwesomeIcon or with some other function?
Thank you for any help you can offer!
There is a code:

library(shiny)
library(sf)
library(leaflet)
library(leaflet.extras2)
df <- sf::st_as_sf(atlStorms2005)[1,]
dfp <- suppressWarnings(st_cast(df, "POINT"))
dfp$duratios = sample(c(1000, 1500, 2000, 2500, 3000), nrow(dfp), TRUE)

# it works
shipIcon <- makeIcon(
  iconUrl = "https://cdn-icons-png.flaticon.com/512/1355/1355883.png",
  iconWidth = 40, iconHeight = 50,
  iconAnchorX = 0, iconAnchorY = 0
)

# it doesn't work
shipIcon2 <- makeAwesomeIcon(icon = "arrow-up",
                iconRotate = 90,
                squareMarker = TRUE,
                markerColor = "black")

ui <- fluidPage(
              leafletOutput("map", height = 800)))

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet()  %>% addTiles() %>%
      addPolylines(data = df) %>%
      addMovingMarker(data = dfp,
                      duration = ~duratios,
                      icon = shipIcon2,
                      movingOptions = movingMarkerOptions(autostart = TRUE,
                                                          loop = TRUE,
                                                          pauseOnZoom = TRUE)
      )
  })
}
shinyApp(ui, server)

Using CQL or OGC filters on addWMS()

Hi,

I was wondering if it was possible to apply a filter to show only a part of a layer when using addWMS() and I didn't see any issue or documentation here about this. But I tried myself and it works! I thought to share it for anyone who might need it, or to be included in a future vignette.

You just need to pass the filter in baseUrl. Here I filtered on attributes using a CQL filter:

library(magrittr)
test <- leaflet::leaflet() %>%
  leaflet.extras2::addWMS(
    baseUrl = "http://geo.vliz.be/geoserver/Ecoregions/wms?cql_filter=mrgid=21885",
    layers = "ecoregions",
    options = leaflet::WMSTileOptions(
      transparent = TRUE,
      format = "image/png",
      info_format = "text/html"
    ),
    attribution = shiny::HTML("<a href='https://marineregions.org/'>Marine Regions</a>") 
  )

sessionInfo()
#> R version 3.6.3 (2020-02-29)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 18.04.6 LTS
#> 
#> Matrix products: default
#> BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
#> 
#> locale:
#>  [1] LC_CTYPE=C.UTF-8       LC_NUMERIC=C           LC_TIME=C.UTF-8       
#>  [4] LC_COLLATE=C.UTF-8     LC_MONETARY=C.UTF-8    LC_MESSAGES=C.UTF-8   
#>  [7] LC_PAPER=C.UTF-8       LC_NAME=C              LC_ADDRESS=C          
#> [10] LC_TELEPHONE=C         LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C   
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] magrittr_2.0.1
#> 
#> loaded via a namespace (and not attached):
#>  [1] Rcpp_1.0.7            rstudioapi_0.13       knitr_1.38           
#>  [4] xtable_1.8-4          R6_2.5.1              rlang_1.0.2          
#>  [7] fastmap_1.0.1         stringr_1.4.0         highr_0.8            
#> [10] tools_3.6.3           xfun_0.30             cli_3.0.1            
#> [13] withr_2.5.0           htmltools_0.5.0       crosstalk_1.1.0.1    
#> [16] yaml_2.2.1            leaflet_2.0.3         digest_0.6.25        
#> [19] shiny_1.5.0           later_1.1.0.1         promises_1.1.1       
#> [22] htmlwidgets_1.5.1     fs_1.5.0              mime_0.9             
#> [25] glue_1.4.2            evaluate_0.15         rmarkdown_2.11       
#> [28] reprex_2.0.1          stringi_1.7.5         compiler_3.6.3       
#> [31] leaflet.extras2_1.1.0 httpuv_1.5.4

Created on 2022-06-22 by the reprex package (v2.0.1)

Thanks for the package!

Release leaflet.extras2 1.2.1

Prepare for release:

  • git pull
  • Check current CRAN check results
  • Polish NEWS
  • urlchecker::url_check()
  • devtools::check(remote = TRUE, manual = TRUE)
  • devtools::check_win_devel()
  • rhub::check_for_cran()
  • revdepcheck::revdep_check(num_workers = 4)
  • Update cran-comments.md
  • git push

Submit to CRAN:

  • usethis::use_version('patch')
  • devtools::submit_cran()
  • Approve email

Wait for CRAN...

  • Accepted 🎉
  • git push
  • usethis::use_github_release()
  • usethis::use_dev_version()
  • git push

Drift markers to new location

There are limitations to addMovingMarker() and addPlayback(). For example, there is no way to add a dynamic popup to addMovingMarker(), and I don't think you can add a popup to addPlayback() currently.

I tried performing linear interpolation of points that are relatively far away from each other and animating using shiny and sliderInput(). The problem with this approach is that the map cannot update quickly enough to speed up the animation sufficiently fast. So you have to choose between smoothness of the transition and speed.

I'm wondering if there is solution in drifting markers smoothly from one location to another.

Sorta like this:
https://github.com/hugobarragon/react-leaflet-drift-marker

Timeslider documentation

I'm trying to get the timeslider functionality to work but there may be gaps in the documentation which are preventing me from getting something working.

For example, if I have a 6 row dataframe giving an attribute of two nodes at three specific time points (say, years), can I produce a map with a slider showing how this attribute (node colour) changes through time at these nodes? I'm ok with converting this to an sf points object and I'm using CircleMarkers.

addArrowhead function not rendering

Using R 4.1.2 and tried both CRAN and dev version of package.
Example renders a blank map. No error msgs. Other functions work.
library(leaflet)
leaflet() %>%
addArrowhead(data = atlStorms2005)

addWMS - authentication for title layer

Hi,

I am using a leaflet map in my RShiny application and would like to access an authenticated title layer. From the documentation I see that this feature is not currently supported. If there a way to add an authorisation header(bearer token authentication) to my request using the addWMS ? Or is there a workaround for the same ?

Many thanks in advance!

addSidebar causing issues if multiple leaflet maps are in one R shiny app

In an R shiny app containing a single leaflet map (id ="map") with sidebars, everything works as intended. When another leaflet map (id = "map2") is included anywhere in the app, the sidebars in "map" fail to load and properly render. Additionally, one or both of "map" sidebars appear in "map2".

A reproducible example is shown below. I expected "map" to have two fully functioning sidebars and "map2" to have no sidebars. Instead, "map" has two non-functioning sidebars and "map2" has one of "map"'s non-functioning sidebars. Any help is much appreciated.

`library(sf)
library(shiny)
library(leaflet)
library(leaflet.extras2)

data(breweries91, package = "leaflet")

ui <- fluidPage(
h4("Leaflet Sidebar Plugin"),
splitLayout(
cellWidths = c("27%", "73%"),
tagList(
actionButton("open", "Open Sidebar"),
actionButton("close", "Close Sidebar"),
actionButton("clear", "Clear Sidebar")
),
tagList(
leafletOutput("map", height = "700px", width = "100%"),
## Sidebar 1 #############
sidebar_tabs(id = "mysidebarid",
list(icon("car"), icon("user"), icon("envelope")),
## Sidebar 1 - Pane #############
sidebar_pane(
title = "home", id = "home_id", icon = icon("home"),
tagList(
sliderInput("obs", "Number of observations:",
min = 1, max = 32, value = 10),
sliderInput("opa", "Point Opacity:",
min = 0, max = 1, value = 0.5),
sliderInput("fillopa", "Fill Opacity:",
min = 0, max = 1, value = 0.2),
dateRangeInput("daterange4", "Date range:",
start = Sys.Date() - 10,
end = Sys.Date() + 10),
verbatimTextOutput("tab1")
)
),
## Sidebar 1 - Pane #############
sidebar_pane(
title = "profile", id = "profile_id", icon = icon("wrench"),
tagList(
textInput("caption", "Caption", "Data Summary"),
selectInput("label", "Label",
choices = c("brewery","address", "zipcode", "village")),
passwordInput("password", "Password:"),
actionButton("go", "Go"),
verbatimTextOutput("value")
)
),
## Sidebar 1 - Pane #############
sidebar_pane(
title = "messages", id = "messages_id", icon = icon("person"),
tagList(
checkboxGroupInput("variable", "Variables to show:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear")),
tableOutput("data")
)
)
),
## Sidebar 2 #############
sidebar_tabs(id = "animalsidebar",
list(icon("kiwi-bird"), icon("frog")),
## Sidebar 2 - Pane #############
sidebar_pane(
title = "kwi", id = "kiwi_id", icon = icon("kiwi-bird"),
tagList(
p("Kiwi birds are awesome.")
)
),
## Sidebar 2 - Pane #############
sidebar_pane(
title = "frog", id = "frog_id", icon = icon("frog"),
tagList(
p("No frogs are better.")
)
)
)
)
),
leafletOutput("map2", height = "700px", width = "100%"),
)

Server

server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
## Add Controls on all sides #########
addEasyButton(easyButton(position = "topleft",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(1);}"))) %>%
addEasyButton(easyButton(position = "topright",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(2);}"))) %>%
addEasyButton(easyButton(position = "bottomright",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(3);}"))) %>%
addEasyButton(easyButton(position = "bottomleft",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(4);}"))) %>%
## Add Sidebar ##########
addSidebar(
id = "mysidebarid",
options = list(position = "left")
) %>%
addSidebar(
id = "animalsidebar",
options = list(position = "right")
)
})
observe({
req(input$obs)
df <- breweries91[sample.int(nrow(breweries91), input$obs), ]
bbox <- st_bbox(df)
leafletProxy("map", session) %>%
clearGroup("pts") %>%
addCircleMarkers(data = df,
label = df[[input$label]],
opacity = input$opa,
fillOpacity = input$fillopa,
group = "pts") %>%
fitBounds(bbox[[1]], bbox[[2]], bbox[[3]], bbox[[4]])
})

output$tab1 <- renderText({
input$obs
})
output$value <- renderText({
req(input$go)
isolate(input$password)
})
output$data <- renderTable(rownames = FALSE, {
mtcars[, c("mpg", input$variable), drop = FALSE]
})

observeEvent(input$open, {
tab_ids <- c(rep("mysidebarid", 3), rep("animalsidebar", 2))
pane_ids <- c("home_id", "profile_id", "messages_id", "kiwi_id", "frog_id")
idx <- sample.int(length(pane_ids), 1)
leafletProxy("map", session) %>%
openSidebar(pane_ids[idx], tab_ids[idx])
})
observeEvent(input$close, {
leafletProxy("map", session) %>%
closeSidebar(sample(c("mysidebarid", "animalsidebar"), 1))
})
observeEvent(input$clear, {
leafletProxy("map", session) %>%
removeSidebar(sample(c("mysidebarid", "animalsidebar"), 1))
})

output$map2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
## Add Controls on all sides #########
addEasyButton(easyButton(position = "topleft",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(1);}"))) %>%
addEasyButton(easyButton(position = "topright",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(2);}"))) %>%
addEasyButton(easyButton(position = "bottomright",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(3);}"))) %>%
addEasyButton(easyButton(position = "bottomleft",
icon = htmltools::span(class = "star", htmltools::HTML("★")),
onClick = JS("function(btn, map){ map.setZoom(4);}")))
})

}
shinyApp(ui, server)
`

addWMS with interactive options

Hi Everyone
I tried to use the addWMS in shiny to plot a map from web services. I want the map from addWMS to change dynamically when I provide a different DateTime to it.
The addWMS could plot the map with provided initial DateTime. However, no map was shown when I change the DateTime with a sidebar. I am sure the input DateTime is correct. and the error from the console are the following.
How I use addWMS in R

  output$mymap <- renderLeaflet({
    leaflet() %>%
      setView(lng = -76, lat = 47, zoom = 4) %>%
      addProviderTiles(providers$OpenStreetMap.Mapnik) %>%
      addWMS(baseUrl = baseUrl,
             layers = "GEPS_Pgrid_3hr",
             options = WMSTileOptions(
               version = "1.3",
               showContours="false",
               #time= "2022-11-10T21:00:00Z",
               time= datetime_list()$few_time,
               styles = "",
               format = "image/png",
               transparent = "true",
               uppercase = "false"
             )
      )
  })

The error from concole

Uncaught TypeError: t.onRemove is not a function
    at e.removeLayer (leaflet.js:5:65194)
    at e.removeFrom (leaflet.js:5:64166)
    at e.remove (leaflet.js:5:64092)
    at e.remove (leaflet.js:5:36838)
    at Object.renderValue (leaflet.js:633:15)
    at Object.renderValue (htmlwidgets.js:889:25)
    at shinyBinding.renderValue (htmlwidgets.js:543:20)
    at e.value (outputBinding.ts:48:12)
    at delegator.<computed> [as onValueChange] (htmlwidgets.js:112:23)
    at e.value (outputAdapter.ts:39:20)
leaflet.js:5 
        
       Uncaught Error: Map container is being reused by another instance
    at e.remove (leaflet.js:5:36414)
    at Object.renderValue (leaflet.js:633:15)
    at Object.renderValue (htmlwidgets.js:889:25)
    at shinyBinding.renderValue (htmlwidgets.js:543:20)
    at e.value (outputBinding.ts:48:12)
    at delegator.<computed> [as onValueChange] (htmlwidgets.js:112:23)
    at e.value (outputAdapter.ts:39:20)
    at e.value (shinyapp.ts:565:17)
    at e.<anonymous> (shinyapp.ts:743:20)
    at e.value (shinyapp.ts:724:29)
leaflet.js:5 
        
       Uncaught TypeError: Cannot read properties of undefined (reading 'style')
    at wt (leaflet.js:5:9820)
    at e.<anonymous> (leaflet.js:5:47376)
    at e.fire (leaflet.js:5:16621)
    at e.invalidateSize (leaflet.js:5:34738)
    at Object.resize (leaflet.js:798:15)
    at Object.resize (htmlwidgets.js:892:25)
    at shinyBinding.resize (htmlwidgets.js:553:24)
    at outputAdapter.ts:26:17
    at e.onResize (index.ts:138:5)
    at HTMLDivElement.<anonymous> (init.ts:266:15)

Contribute guide

Hi @trafficonese

Could you provide a simple guide to indicate how to contribute to this repo? I want to add some library to leaflet.extras2, but I don't know how to start it. I read through the antpath binding js but don't know what is LeafletWidget.

Thank you!

menuItem() function

The new menuItem() function causes me a problem with other packages, such as shiny or shinydashboards. If it were possible to change the name of the function in future versions

Leaflet.extras2 incompatible with shiny dashboard ?

Hi,

I develop a web interface via R with shiny, leaflet, mapedit, and mapview (these are the main packages used).
To add a popup with WMS data in my map, I use the leaflet.extras2 package.
In my shiny application, I also added a dashboard.
But, when I use addWMS() from the leaflet.extras2 package with the dashboard, my page does not work. (Code n°1)
To test, I added my WMS feed with the addWMStiles function (from the leaflet package and without popup), and my page works perfectly. (Code 2)
The results are at the end of the post.

When the Leaflet.extras2 package is loaded, the shiny dashboard does not work?
Does anyone have a solution?
Thank you very much in advance.

Code n°1 : Using addWMS() with dashboard (when leaflet.extra is charged) :

library(shiny)
library(shinydashboard)
library(sf)
library(mapview)
library(mapedit)
library(leaflet.extras)
library(plainview)
library(leafsync)
library(shinyWidgets)
require(tmaptools)
require(leaflet.extras2)

mapviewOptions(basemaps = c("OpenStreetMap.Mapnik","GeoportailFrance.orthos"),
               viewer.suppress = TRUE, 
               homebutton.pos="bottomleft",
               layers.control.pos="bottomleft")

m = mapview()
m@map = m@map %>% 
  setView(lat=46.28336925761807 ,lng = 2.875103294898822,zoom = 5)%>% 
  addWMS(group = "RPG2019",
         baseUrl = "https://geobretagne.fr/geoserver/draaf/wfs",
         layers = c("RPG_PARCELLES_R53_2018"),
         options = leaflet::WMSTileOptions(
           transparent = TRUE,
           format = "image/png",
           info_format = "text/html",
           tiled = FALSE))%>% 
  addWMS(group = "Hydro",
         baseUrl = "https://geobretagne.fr/geoserver/ddtm29/wfs",
         layers = c("L_INVENTAIRE_CE_DDTM_029"),
         options = leaflet::WMSTileOptions(
           transparent = TRUE,
           format = "image/png",
           info_format = "text/html",
           tiled = FALSE))%>%
  addLayersControl(overlayGroups = c("RPG2019","Hydro"),
                   options = layersControlOptions(collapsed = FALSE,),
                   position = "bottomleft")%>%
  hideGroup(c("RPG2019","Hydro"))%>%
  addSearchOSM(options = searchOptions(collapsed = FALSE,position = "topright"))%>%
  addMeasure(position = "bottomright", primaryLengthUnit = "meters", primaryAreaUnit = "sqmeters",localization = "fr")

# ui ---------------------------------------------------------------------------

ui <- dashboardPage(
  
  # title ----
  dashboardHeader(title = "Title"),
  
  # sidebar ----
  dashboardSidebar(
    sidebarMenu(id = "sidebarid",
                menuItem("Paramétrage", tabName = "page1"),
                menuItem("Edition", tabName = "page2"),
                menuItem("Visualisation", tabName = "page3"))
  )
  ,
  # body ----
  dashboardBody(
    tabItems(
      # page 1 ----
      tabItem(tabName = "page1"),
      #page 2 ---
      tabItem(tabName = "page2",
              fluidRow(column(12,editModUI("mapin",height=600)))),
      #page 3 ---
      tabItem(tabName = "page3",
              sliderInput("tampon",  "Largeur de la bande enherbée (si existante)", value =5, min=1, max = 30),
              fluidRow(column(12,leafletOutput("mapout",height=600))))
    )
  )
)

# server -----------------------------------------------------------------------

server <- function(input, output, session) {
  #page 1
  BE <- callModule(editMod, "mapin",m@map)
  
  #page 2
  output$mapout <- renderLeaflet({
    req(BE()$finished)
    x<-mapview(st_buffer(BE()$finished, input$tampon/2), layer.name="BE")
    x@map = x@map %>% 
      addWMS(group = "RPG2019",
             baseUrl = "https://geobretagne.fr/geoserver/draaf/wfs",
             layers = c("RPG_PARCELLES_R53_2018"),
             options = leaflet::WMSTileOptions(
               transparent = TRUE,
               format = "image/png",
               info_format = "text/html",
               tiled = FALSE))%>% 
      addWMS(group = "Hydro",
             baseUrl = "https://geobretagne.fr/geoserver/ddtm29/wfs",
             layers = c("L_INVENTAIRE_CE_DDTM_029"),
             options = leaflet::WMSTileOptions(
               transparent = TRUE,
               format = "image/png",
               info_format = "text/html",
               tiled = FALSE))%>%
      addLayersControl(overlayGroups = c("RPG2019","Hydro"),
                       options = layersControlOptions(collapsed = FALSE,),
                       position = "bottomleft")%>%
      hideGroup(c("RPG2019","Hydro"))%>%
      addSearchOSM(options = searchOptions(collapsed = FALSE,position = "topright"))%>%
      addMeasure(position = "bottomright", primaryLengthUnit = "meters", primaryAreaUnit = "sqmeters",localization = "fr")
 
  })
}

# shiny app --------------------------------------------------------------------

shinyApp(ui, server)

Code n°2 : Using addWMSTile() with dashboard (when leaflet.extra is not charged) :

library(shiny)
library(shinydashboard)
library(sf)
library(mapview)
library(mapedit)
library(leaflet.extras)
library(plainview)
library(leafsync)
library(shinyWidgets)
require(tmaptools)

mapviewOptions(basemaps = c("OpenStreetMap.Mapnik","GeoportailFrance.orthos"),
               viewer.suppress = TRUE, 
               homebutton.pos="bottomleft",
               layers.control.pos="bottomleft")

#pmpview page 1 
m = mapview()
m@map = m@map %>% 
  setView(lat=46.28336925761807 ,lng = 2.875103294898822,zoom = 5)%>% 
  addWMSTiles(group = "RPG2019",
              baseUrl = "https://geobretagne.fr/geoserver/draaf/wfs",
              layers = "RPG_PARCELLES_R53_2018",
              options = WMSTileOptions(format = "image/png",
                                       uppercase = TRUE,
                                       transparent = TRUE,
                                       continuousWorld=TRUE,
                                       tiled = FALSE,
                                       info_format="text/html",
                                       identify = FALSE,
                                       zIndex = 3,
                                       opacity = 1))%>% 
  addWMSTiles(group = "Hydro",
              baseUrl = "https://geobretagne.fr/geoserver/ddtm29/wfs",
              layers = "L_INVENTAIRE_CE_DDTM_029",
              options = WMSTileOptions(format = "image/png",
                                       uppercase = TRUE,
                                       transparent = TRUE,
                                       continuousWorld=TRUE,
                                       tiled = FALSE,
                                       info_format="text/html",
                                       identify = FALSE,
                                       zIndex = 4,
                                       opacity = 1))%>%
  addDrawToolbar(editOptions = editToolbarOptions(edit=TRUE),
                 polygonOptions = FALSE,
                 circleOptions = FALSE,
                 rectangleOptions = FALSE,
                 markerOptions = FALSE,
                 circleMarkerOptions = FALSE)%>%
  mapview:::mapViewLayersControl(names = c("RPG2019","Hydro"))%>%
  addSearchOSM(options = searchOptions(collapsed = FALSE,position = "topright"))%>%
  addMeasure(position = "bottomright", primaryLengthUnit = "meters", primaryAreaUnit = "sqmeters",localization = "fr")

# ui ---------------------------------------------------------------------------

ui <- dashboardPage(
  
  # title ----
  dashboardHeader(title = "Title"),
  
  # sidebar ----
  dashboardSidebar(
    sidebarMenu(id = "sidebarid",
                menuItem("Paramétrage", tabName = "page1"),
                menuItem("Edition", tabName = "page2"),
                menuItem("Visualisation", tabName = "page3"))
    )
  ,
  # body ----
  dashboardBody(
    tabItems(
      # page 1 ----
      tabItem(tabName = "page1"),
      #page 2 ---
      tabItem(tabName = "page2",
              fluidRow(column(12,editModUI("mapin",height=600)))),
      #page 3 ---
      tabItem(tabName = "page3",
              sliderInput("tampon",  "Largeur de la bande enherbée (si existante)", value =5, min=1, max = 30),
              fluidRow(column(12,leafletOutput("mapout",height=600))))
         
    )
  )
)

# server -----------------------------------------------------------------------

server <- function(input, output, session) {
  #data<-eventReactive(input$go,{input$adresse })
  
  #page 1
  BE <- callModule(editMod, "mapin",m@map)
  
  #page 2
  output$mapout <- renderLeaflet({
    req(BE()$finished)
    x<-mapview(st_buffer(BE()$finished, input$tampon/2), layer.name="BE")
    x@map = x@map %>% addWMSTiles(group ="RPG2019" ,
                                  baseUrl = "https://geobretagne.fr/geoserver/draaf/wfs",
                                  layers = "RPG_PARCELLES_R53_2018",
                                  options = WMSTileOptions(format = "image/png",
                                                           uppercase = TRUE,
                                                           transparent = TRUE,
                                                           continuousWorld=TRUE,
                                                           tiled = FALSE,
                                                           info_format="text/html",
                                                           identify = FALSE,
                                                           zIndex = 3,
                                                           opacity = 1))%>% 
      addWMSTiles(group = "Hydro" ,
                  baseUrl = "https://geobretagne.fr/geoserver/ddtm29/wfs",
                  layers = "L_INVENTAIRE_CE_DDTM_029",
                  options = WMSTileOptions(format = "image/png",
                                           uppercase = TRUE,
                                           transparent = TRUE,
                                           continuousWorld=TRUE,
                                           tiled = FALSE,
                                           info_format="text/html",
                                           identify = FALSE,
                                           zIndex = 4,
                                           opacity = 1))%>%
      mapview:::mapViewLayersControl(names = c("RPG2019","Hydro"))%>%
      addMeasure(position = "bottomright", primaryLengthUnit = "meters", primaryAreaUnit = "sqmeters",localization = "fr")
  
  })
}

# shiny app --------------------------------------------------------------------

shinyApp(ui, server)

Results of Code n°1 and Code N°2

with_leafletextra2
without_leafletextra22

Release leaflet.extras2 1.2.0

Prepare for release:

  • Check current CRAN check results
  • Polish NEWS
  • urlchecker::url_check()
  • devtools::check(remote = TRUE, manual = TRUE)
  • devtools::check_win_devel()
  • rhub::check_for_cran()
  • revdepcheck::revdep_check(num_workers = 4)
  • Update cran-comments.md
  • Review pkgdown reference index for, e.g., missing topics

Submit to CRAN:

  • usethis::use_version('minor')
  • devtools::submit_cran()
  • Approve email

Wait for CRAN...

  • Accepted 🎉
  • usethis::use_github_release()
  • usethis::use_dev_version()

addWMS() is not showing the maps

I'd I tried around a lot, but addWMS() doenst't work in my case. I tried it with my data first and then I used your example https://github.com/trafficonese/leaflet.extras2/blob/master/inst/examples/wms_popup.R. If I use leaflet.extras2::addWMS() there is no WMS displayed. If I use the same with addWMSTiles (and without the popup) I can see the WMSmap but I can't use the popup Feature for the getFeatureInformation I really need.

`- Session info --------------------------------------------------------------------------
setting value
version R version 3.5.1 (2018-07-02)
os Windows >= 8 x64
system x86_64, mingw32
ui RStudio
language (EN)
collate German_Germany.1252
ctype German_Germany.1252
tz Europe/Berlin
date 2020-06-15

  • Packages ------------------------------------------------------------------------------
    package * version date lib source
    assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.5.3)
    cli 1.1.0 2019-03-19 [1] CRAN (R 3.5.3)
    crayon 1.3.4 2017-09-16 [1] CRAN (R 3.5.1)
    crosstalk 1.1.0.1 2020-03-13 [1] CRAN (R 3.5.3)
    digest 0.6.18 2018-10-10 [1] CRAN (R 3.5.3)
    fastmap 1.0.1 2019-10-08 [1] CRAN (R 3.5.3)
    htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.5.3)
    htmlwidgets 1.5.1 2019-10-08 [1] CRAN (R 3.5.3)
    httpuv 1.5.2 2019-09-11 [1] CRAN (R 3.5.3)
    jsonlite 1.6 2018-12-07 [1] CRAN (R 3.5.3)
    later 1.0.0 2019-10-04 [1] CRAN (R 3.5.3)
    lattice 0.20-38 2018-11-04 [1] CRAN (R 3.5.1)
    leaflet * 2.0.3 2019-11-16 [1] CRAN (R 3.5.3)
    leaflet.extras2 * 1.0.0.9000 2020-06-12 [1] Github (4ed1748)
    magrittr 1.5 2014-11-22 [1] CRAN (R 3.5.3)
    mime 0.6 2018-10-05 [1] CRAN (R 3.5.2)
    promises 1.1.0 2019-10-04 [1] CRAN (R 3.5.3)
    R6 2.4.0 2019-02-14 [1] CRAN (R 3.5.3)
    Rcpp 1.0.1 2019-03-17 [1] CRAN (R 3.5.3)
    rlang 0.4.5 2020-03-01 [1] CRAN (R 3.5.3)
    rsconnect 0.8.16 2019-12-13 [1] CRAN (R 3.5.3)
    rstudioapi 0.11 2020-02-07 [1] CRAN (R 3.5.3)
    sessioninfo * 1.1.1 2018-11-05 [1] CRAN (R 3.5.3)
    shiny * 1.4.0.2 2020-03-13 [1] CRAN (R 3.5.3)
    sp * 1.3-1 2018-06-05 [1] CRAN (R 3.5.3)
    withr 2.1.2 2018-03-15 [1] CRAN (R 3.5.3)
    XML * 3.99-0.3 2020-01-20 [1] CRAN (R 3.5.3)
    xtable 1.8-4 2019-04-21 [1] CRAN (R 3.5.3)
    yaml 2.2.0 2018-07-25 [1] CRAN (R 3.5.2) `

addWMS() does not hide the attribution when corresponding group is hidden

After adding a WMS layer with addWMS(), the attribution display at the bottom is not toggled when the group is shown or hidden respectively. This contrasts with such toggle-behaviour in leaflet::addWMSTiles(), where the attribution is hidden if the group is hidden.

The attached zipped html notebook – leaflet_issue_notebook.nb.html.zip – compares this behaviour between leaflet (first map) and leaflet.extras2 (second map).

I believe leaflet.extras2 should follow the behaviour of leaflet for this.

Feature Request: Leaflet.VectorGrid for rendering medium to large datasets efficiently in Leaflet

Hi guys. First: Great work. Thanks for this library!

Any chance rendering vector tiles could make it into the project here?

https://github.com/Leaflet/Leaflet.VectorGrid.

It's one of the most important features besides raster tiles to display large datasets. Otherwise, Leaflet in R/Shiny is always bound to work with very small polygon datasets or operate with a very low/unusable rendering speed.

This issue was moved from the leaflet repo for R here as suggested by @tim-salabim

addEasyprint does only export the top part of a map for "Current Size"

First of all, many thanks for the great work!

The (wonderful !) easyprint-button only exports the first row of tiles when setting the extent to current size. A4 seems to work.n Tested on Chrome and Safari with the latest version of leaflet.extras2.

pacman::p_load(dplyr, leaflet, leaflet.extras2)

m <- gadmCHE %>% leaflet() %>%
  addPolygons(fillColor = ~colors(NAME_1), fillOpacity = 1,group = "Kantone") %>%
  leaflet.extras2::addEasyprint(options = easyprintOptions(position = "topright",
                                            exportOnly=FALSE, #or true does not change much
                                            filename ="Anmerkung")
              )

htmlwidgets::saveWidget(m,"test_export.html")

Anmerkung-6

addVelocity not work

library(leaflet)
library(leaflet.extras2)
content <- "https://raw.githubusercontent.com/onaci/leaflet-velocity/master/demo/water-gbr.json"

leaflet() %>%
  addTiles(group = "base") %>%
  setView(145, -20, 4) %>%
  addVelocity(content = f, group = "velo", layerId = "veloid") %>%
  addLayersControl(baseGroups = "base", overlayGroups = "velo")

The example not work.

image

Graphical artifact when hidden option set to TRUE in addEasyprint

Hi, I mainly use easyPrint with a programmatic button so I set the hidden option of addEasyprint to TRUE. But in the example below I see a small gray dot at the top left of the screen just below the invisible print button of leaflet which is hidden in this configuration... If I remove the addEasyprint part the point disappears. Hope you can still do something for me on this one. Thanks a lot !

library(shiny)
library(leaflet)
library(leaflet.extras2)

ui <- fluidPage(
    leafletOutput("map"),
    selectInput("scene", "Select Scene", choices=c("Current",
                                                   "A4Landscape",
                                                   "A4Portrait")),
    actionButton("print", "Print Map")
)

server <- function(input, output, session) {
    output$map <- renderLeaflet({
        input$print
        leaflet(options=leafletOptions(zoomControl=FALSE))  %>%
            addTiles() %>%
            setView(0, 0, 9) %>%
            addEasyprint(options=easyprintOptions(
                             sizeModes=c("Current",
                                         "A4Landscape",
                                         "A4Portrait"),
                             exportOnly=TRUE,
                             hidden=TRUE
                         ))
    })
    observeEvent(input$print, {
        leafletProxy("map") %>%
            easyprintMap(sizeModes=input$scene)
    })
}

shinyApp(ui, server)

addWMS() no layerId argument

I'm trying to make the Sidebyside with two WMS layers, but I need a layerId to do that. The addWMS() function does not have a layerId argument. Is there any way to make this work?

Possibility with easyPrint to print also a Shiny panel on map

Hi, the easyPrint user again! Is there a way to make easyPrint able to also print a Shiny panel (or even an actionButton) with the map as in the example below ? Could it be done with a vector of Shiny id for example ?

library(shiny)
library(leaflet)
library(leaflet.extras2)

ui <- fluidPage(
    leafletOutput("map"),
    selectInput("scene", "Select Scene", choices=c("CurrentSize",
                                                     "A4Landscape",
                                                     "A4Portrait")),
    actionButton("print", "Print Map"),

    absolutePanel(
        id="panel",
        style="background-color: rgba(200, 200, 200, 0.9);",
        fixed=TRUE,
        width="auto", height="auto",
        right=50, top=50,
        tags$h1("Title")
        )
        
)

server <- function(input, output, session) {
    output$map <- renderLeaflet({
        input$print
        leaflet()  %>%
            addTiles() %>%
            setView(10, 50, 9) %>%
            addEasyprint(options=easyprintOptions(exportOnly=TRUE))
    })
    observeEvent(input$print, {
        leafletProxy("map") %>%
            easyprintMap(sizeModes=input$scene)
    })
}

shinyApp(ui, server)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.