I'm finding it impossible to add the popups that are possible to add in JS via R's Leaflet.MapBoxGL library. This library lacks native popup functionality.
Can anyone give me some pointers on how I might augment the code so as to do this in R. I'd rather not scrap my work and start over in JS if at all possible.
library(shiny)
library(leaflet)
library(leaflet.mapboxgl)
ui <- fluidPage(
titlePanel("Panel"),
leafglOutput("map")
)
server = function(input, output, session) {
map = createLeafletMap(session, 'map')
session$onFlushed(once = T, function() {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = pathOptions(pane = "background_map")) %>%
addMapboxGL(style = "mapbox://styles/thirdhuman/cjzn4e0xz1ed41cnq6ni0qckl",
,group = "Rural"
,layerId = "Rural"
,popup = paste0(
"<b>Country: </b>")
,option = pathOptions(pane = "Rural"))
})
})
}
shinyApp(ui, server)
Error:
Warning: Error in addMapboxGL: unused argument (popup = paste0("<b>Country:
</b>"))
I'd like to figure out some way to make this work. Above is minimal example, but my real code has multiple layers of these MapBoxGL style layers.
Related
Hello This chart bellow is a part of my dashboard but its making the dashboard have a bad performance.
It takes time do update.
Is there any alternative to the functions htmlOutput()+ renderUI() ?
How can I improve the performance? Is it the case to create and generate the charts outside the server?
library(shiny)
library(highcharter)
library(tidyverse)
df <-tibble(months = month.abb, value = ts(cumsum(rnorm(100)))[1:12] )
ui <- fluidPage(
h1("Highcharts"),
htmlOutput('chart_grid')
)
server <- function(input, output, session) {
output$chart_grid<- renderUI({
charts <- lapply(1:9, function(x) {
highchart() %>%
hc_add_series(type = 'spline',data = df, hcaes(x = months,y = value))%>%
hc_xAxis(categories = df$months)
})
hw_grid(charts, rowheight = 300,add_htmlgrid_css = TRUE)%>%
htmltools::browsable()
})
}
shinyApp(ui, server)
TL;DR highcharts JS boost module for many data points, static HTML for a plot if there is one or a few plot versions, own grid and highcharter::highchartOutput
Static HTML
Strategy is to create the needed plot before the shiny app is started, but we have to assume that the plot have one or a few versions as a huge collection of html's could be a wrong direction too.
Usually we are using htmlwidgets::saveWidget to save any shiny widgets so we could get its html representation. As the hw_grid is not returning a shiny widgets I save it as a regular html but we have to take care of the dependencies.
Here I use the hchart (not highchart) as it persists labels on the plots.
You do not have to leave the code for html creation in the app.R file. But in my example you need still leave the dependencies list.
Then you could add dependencies in the DOM head with htmltools::renderDependencies(htmltools::resolveDependencies(DEPS)).
Remember that when you deploy the shiny app you have to add static files with e.g. addResourcePath https://shiny.rstudio.com/reference/shiny/1.0.2/addResourcePath.html
library(shiny)
library(highcharter)
library(tidyverse)
library(magrittr)
df <- tibble::tibble(months = month.abb, value = ts(cumsum(rnorm(100)))[1:12])
charts <- lapply(1:9, function(x) {
hchart(df, type = "spline", hcaes(x = months, y = value)) %>%
hc_xAxis(categories = df$months) %>%
hc_boost(enabled = TRUE)
})
hc_test <- hw_grid(charts, rowheight = 300, add_htmlgrid_css = TRUE, browsable = TRUE)
# get HTML of the plot
# we could not use htmlwidgets::saveWidget as it is not a widget
writeLines(as.character(hc_test), "hc_test.html")
# get the dependencies of the plot
hc_deps <- htmltools::findDependencies(hc_test)
# unique dependencies in the HTML format, could be added in the head
# htmltools::renderDependencies(htmltools::resolveDependencies(hc_deps))
ui <- fluidPage(
h1("Highcharts"),
htmlOutput("chart_grid")
)
server <- function(input, output, session) {
output$chart_grid <- renderUI({
# Load HTML with proper dependencies
htmltools::attachDependencies(
shiny::HTML(readLines("hc_test.html")),
htmltools::resolveDependencies(hc_deps)
)
})
}
shinyApp(ui, server)
Boost module
The source highcharts JS library offers a boost module which could boost the performance. From the perspective of R it is as easy as adding hc_boost(enabled = TRUE) to your pipeline.
https://www.highcharts.com/docs/advanced-chart-features/boost-module
As I understand the hc_boost could improve performance only in specific scenarios and for the cost of losing some functionality. I did not test if it truly works as expected.
library(shiny)
library(highcharter)
library(tidyverse)
df <- tibble(months = month.abb, value = ts(cumsum(rnorm(100)))[1:12])
ui <- fluidPage(
h1("Highcharts"),
htmlOutput("chart_grid")
)
server <- function(input, output, session) {
output$chart_grid <- renderUI({
charts <- lapply(1:9, function(x) {
highchart() %>%
hc_add_series(type = "spline", data = df, hcaes(x = months, y = value)) %>%
hc_xAxis(categories = df$months) %>%
hc_boost(enabled = TRUE)
})
hw_grid(charts, rowheight = 300, add_htmlgrid_css = TRUE, browsable = TRUE)
})
}
shinyApp(ui, server)
Highcharts and own grid
library(shiny)
library(highcharter)
library(tidyverse)
df <- tibble(months = month.abb, value = ts(cumsum(rnorm(100)))[1:12])
ui <- fluidPage(
h1("Highcharts"),
shiny::tags$div(
style = "display:flex;flex-wrap: wrap;",
lapply(1:9, function(x) shiny::tags$div(
style = "flex: 1 1 30%;",
highcharter::highchartOutput(sprintf("hplot%s", x)))
)
)
)
server <- function(input, output, session) {
charts <- lapply(1:9, function(x) {
output[[sprintf("hplot%s", x)]] <- highcharter::renderHighchart(
highchart(width = 600) %>%
hc_add_series(type = "spline", data = df, hcaes(x = months, y = value)) %>%
hc_xAxis(categories = df$months)
)
})
}
shinyApp(ui, server)
BTW.
My personal opinion is that the highcharter package need much work regarding the code quality and documentation, e.g. hw_grid does not even have documented the return value.
Is there a way to get to current zoom level of a googleway::google_map ?
I'm trying to get the current zoom level of a shiny map in the same way I access to the coordinate of a marker
(quite same question than How to find current zoom level in a Google Map? but with the googleway package)
thanks !
library(shiny)
library(googleway)
shinyApp(
ui = fluidPage(google_mapOutput("map")),
server = function(input, output, session){
api_key <- "YourAPI_Key"
output$map <- renderGoogle_map({
map<-google_map(key = api_key, location = c(48.80940, 2.326488), zoom = 19)%>%
add_drawing(drawing_modes=c("marker", "polygon"), delete_on_change = F)
map
})
observeEvent(input$map_markercomplete, {
print("Marker Complete")
print(input$map_markercomplete)})
})
shinyApp(ui, server)
I am new to shiny and trying to do some mapping with leaflet.I already have the map layers though in qgs format.How can I use these qgis layers and make custom tiles(layers) for interactive mapping? Guidance on converting the qgis layers into leaflet mapping format would be appreciated.
Here is an image of the layers in QGIS:
Map Layers in QGIS
You can add layers by using e.g. addWMSTiles. Here's a workable example below which add QGIS layer to interactive leaflet Shiny app.
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leafletOutput("mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet(
options = leafletOptions(
center = c(-33.95293, 20.82824),
zoom = 14,
minZoom = 5,
maxZoom = 18,
maxBounds = list(
c(-33.91444, 20.75351),
c(-33.98731, 20.90626)
)
)
) %>%
addWMSTiles(
baseUrl = paste0(
"http://maps.kartoza.com/web/?",
"map=/web/Boosmansbos/Boosmansbos.qgs"
),
layers = "Boosmansbos",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = paste0(
"(c)Kartoza.com and ",
"SA-NGI"
)
) %>%
addWMSLegend(
uri = paste0(
"http://maps.kartoza.com/web/?",
"map=/web/Boosmansbos/Boosmansbos.qgs&&SERVICE=WMS&VERSION=1.3.0",
"&SLD_VERSION=1.1.0&REQUEST=GetLegendGraphic&FORMAT=image/jpeg&LAYER=Boosmansbos&STYLE="
)
)
})
}
shinyApp(ui, server)
I'm working on adding a WMTS layer to my R Leaflet map using this url:
https://mrdata.usgs.gov/mapcache/wmts?layer=alteration&service=WMTS&request=GetCapabilities&version=1.0.0
I add the url into my code under the "addWMSTiles" option in R Leaflet like such:
library(shiny)
library(leaflet)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4) %>%
addWMSTiles("https://mrdata.usgs.gov/mapcache/wmts?layer=alteration&service=WMTS&request=GetCapabilities&version=1.0.0",
layers = "sim3340",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
When I run this code the map will display in the browser but all that displays is the base leaflet (OpenStreets) Map (image below).
When there should be some coloring around CA and AZ since that's that WMTS layer is highlighting.
At first I thought it may be due to there being 3 different projection matrices in the WMTS layer but even if I call crs = "EPSG:6.3:3857" in the addWMSTiles options it still shows up as the base map.
What do I need to change or add to make this WMTS layer show up on the map?
Thank you and as always any help is appreciated!
This should do it. The call to your baseUrl was not correct.
library(shiny)
library(leaflet)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4) %>%
addWMSTiles(baseUrl = "https://mrdata.usgs.gov/mapcache/wms/",
layers = "sim3340",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
I am having trouble adding different layers in my shiny app. I want to add a group of polygons along with a group of circle markers along with a group of arbitrary (.png) icons. I have the group of geojson files that are added in a for loop that is wrapped in an observe({}) statement with the function
map$addGeoJSON(x) where x is a feature with coordinates. The 'map' object is created by the command
map <- createLeafletMap(session, 'map')
This is all fine and dandy, and the polygons get added fine. I also want to commit to this way of adding the polygons. That should not have to change.
The error happens when I try to add markers onto that map object in the same way (e.g. with map$addMarkers(....) ) Below is the error and the code for the app that tries to add markers in the desired way and fails.
The shiny app below with the quakes data recreates my error
"Listening on ...
Warning: Error in observerFunc: attempt to apply non-function
Stack trace (innermost first):
56: observerFunc [C:/Users/jbz/Desktop/leaflet-map-question.R#35]
1: runApp
ERROR: [on_request_read] connection reset by peer"
library(shiny)
library(leaflet)
library(RColorBrewer)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletMap("map", width = "100%", height = "100%",
options=list(center = c(40.736, -73.99), zoom = 14)),
absolutePanel(top = 10, right = 10,
sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
value = range(quakes$mag), step = 0.1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
checkboxInput("legend", "Show legend", TRUE)
)
)
server <- function(input, output, session) {
filteredData <- reactive({
quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
})
colorpal <- reactive({
colorNumeric(input$colors, quakes$mag)
})
map <- createLeafletMap(session, 'map')
observe({
df <- filteredData()
map$addMarkers(
lng=df$Lon, lat=df$Lat, popup = paste(as.character(df$mag)))
})
}
shinyApp(ui, server)
(How) can I add markers correctly while insisting on using the function createLeafletMap()?
map <- createLeafletMap(session, 'map')
try:
library(dplyr)
df <- filteredData()
leafletProxy("map") %>%
addMarkers(df, lng = ~Lon, lat = ~Lat, popup = paste(as.character(df$mag) )
under observe