Publishing a shiny/leaflet map made in R to a website - r

I'm helping a friend doing some research on the number of breweries in CT. With help from this community I was able to make a map of breweries in leaflet and was able to add a slider using shiny. Now I want to be able to give my friend the map so he can add it to the website where he is publishing his research. I'm new to some of this and was wondering if anybody had some ideas for me. Here is the code (thanks to Ben) I used to make the map:
library(shiny)
library(leaflet)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(bottom = 30, right = 10,
textOutput("Counter"),
sliderInput("Year", "Year", 1990, 2000, value = 1995, step = 1, sep = "")
)
)
server <- function(input, output, session) {
sliderData <- reactive({
breweries_subset %>%
filter(YearOpened <= input$Year)
})
output$Counter <- renderText(
paste("Number Breweries: ", nrow(sliderData()))
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(min(breweries_subset$Longitude), min(breweries_subset$Latitude),
max(breweries_subset$Longitude), max(breweries_subset$Latitude))
})
observe({
leafletProxy("map", data = sliderData()) %>%
clearMarkers() %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = 'Breweries',
popup = ~ Name)
})
}
shinyApp(ui = ui, server = server)
UPDATE
I took your suggestions and tried publishing to shinyapps.io. Here's the code I used:
For ui.R:
library(shiny)
library(leaflet)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(bottom = 30, right = 10,
textOutput("Counter"),
sliderInput("Year", "Year", 1990, 2019, value = 1995, step = 1, sep = "")
)
)
And for server.R:
library(shiny)
library(leaflet)
library(leaflet.extras)
library(fontawesome)
library(rsconnect)
function(input, output, session) {
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
sliderData <- reactive({
ct_breweries %>%
filter(YearOpened <= input$Year)
})
output$Counter <- renderText(
paste('Number of Breweries: ', nrow(sliderData()))
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(min(ct_breweries$Longitude), min(ct_breweries$Latitude),
max(ct_breweries$Longitude), max(ct_breweries$Latitude))
})
observe({
leafletProxy('map', data = sliderData()) %>%
clearMarkers() %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = 'Breweries',
popup = ~ Name)
})
}
It works fine locally. When I try to publish it, I get a Disconnected from Server error. In the logs it says something about 'YearOpened' not found. There's definitely a column for that in the .csv. I'm wondering if it has something to do with the call to the fall. Any ideas? Thanks

Try adding all the package loading and dataset reading to a global.R file (in the same app folder) as below:
library(shiny)
library(leaflet)
library(leaflet.extras)
library(fontawesome)
library(rsconnect)
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
You can then remove these from ui.R and server.R.
The problem seems to be that the dataset is not visible to the server - this should fix that. Also, make sure that the csv file is in the same folder.
Update
Based on my comment above, if this is sufficient, you can just save an html file of the map that you can send to your friend to open in a browser. I have attempted to write the code without your data so this may not work.
library(leaflet)
library(fontawesome)
library(htmlwidgets)
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
leaflet_map <- leaflet(data = ct_breweries) %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = ~ YearOpened,
popup = ~ Name) %>%
addLayersControl(
overlayGroups = 1990:2000,
options = layersControlOptions(collapsed = FALSE)
) %>% hideGroup(~ YearOpened)
saveWidget(leaflet_map, file="leaflet_map.html")
It does lose the slider option - replaced with checkboxes. You can remove the hideGroup() and collapsed = FALSE to see other options. This might be easier assuming the slider is not a requirement.
This file is saved offline but you will need an internet connection to fetch the leaflet map tiles.

Related

Change map colourfill based on user selection

It's been a while since i'm having this problem. My current shiny app is not able to communicate with the user selection. It is supposed to show a colour fill variation across different region when a user makes a selection. However, it seems like the map is not showing it. My best guess is that it is not reading the 'pal' function correctly, and not able to capture the selection that the user input.
any kind of help would be great.
library(datasets)
library(dplyr)
library(ggplot2)
library(gridExtra)
library(leaflet)
library(leaflet.extras)
library(Matrix)
library(readxl)
library(rgdal)
library(shiny)
library(stringr)
library(tidyverse)
library(tidyr)
library(RColorBrewer)
cf <- read.csv("datafile.csv")
sgmap55 <-readOGR("shapefile.kml")
bins <-c(1,50,100,150,200)
pal <- colorBin("Blues", domain = NULL, bins = bins, na.color = "#808080")
#5) setting for the labels.
labels <- sprintf(
"<strong>%s</strong><br/>%g respondents </sup>",
cf$planarea, cf$planarea)%>% lapply(htmltools::HTML)
##Section C: ShinyApp starts here
ui <- fluidPage(
titlePanel("Brand Interaction with Regions"),
sidebarLayout(
sidebarPanel(
radioButtons("brand", "Select First Brand:", choices = colnames(cf[,c(3,4,5,6,7,8,9,10,11,12,13,14)]))),
mainPanel(
leafletOutput("sgmap2")
)
)
)
server <- function(input, output, session) {
output$sgmap2 <- renderLeaflet({
selected_brand <- input$brand
leaflet() %>%
addTiles() %>%
addResetMapButton()%>%
clearMarkers()%>%
addProviderTiles("OpenStreetMap") %>%
setView(103.8198,1.3521,11)%>%
addPolygons(data = sgmap55,
highlight = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
fillColor = pal(input$selected_brand),
bringToFront = TRUE))
})
}
shinyApp(ui = ui, server = server)
manage to solve it with below code in between the server portion:
req(input$brand)
cpop <- cf[[input$brand]]

R Leaflet GeoJSON Coloring

I am still working on this R Leaflet self project to learn and I'm trying to color in some Polygons in the Wake County area of Raleigh, NC. Below is the image of what I am trying to color.
https://imgur.com/a/xdvNLvM
Basically I am trying to get each of those polygons colored differently. I've tried addPolygons but I guess I didn't have correct Polygon data. I've looked at color binning but I seem to be out of ideas. Below is my code. I even tried to unnest the GeoJSON data and create a factor palette but that hasn't seemed to work.
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
data <- geojson_read(dataurl, method = 'web', parse = FALSE, what = 'list')
wake <- readOGR(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
#bikedata <- 'D:/bicycle-crash-data-chapel-hill-region.geojson'
#bike <- geojson_read(bikedata)
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- geojson_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
data
})
#bikegeojson <- reactive({
# bike
#})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4)
})
observe({
leafletProxy("map") %>%
addWMSTiles("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",
layers = "nexrad-n0r-900913",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "") %>%
addGeoJSON(wakegeojson(), weight = 3, fill = factpal) %>%
#addGeoJSON(bikegeojson()) %>%
addGeoJSON(vtgeojson(), fill = FALSE, color = "black")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
I think I need to explore the addPolygons feature more but I'm not exactly sure how to do that or how to parse/unnest my GeoJSON data in order to accomplish filling in the Wake County Zipcodes with different colors. Any help is always appreciated. Thank you.
I would switch to sf. You can directly load the geojson and produce a Multipolygon and a Multilinestring object which will also read much faster than readOGR.
Then you can just put those objects in addPolygons and addPolylines.
The following example should work:
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
library(sf)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
wake <- st_read(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- st_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
wake
})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data=wakegeojson(), color=factpal(wake$zips)) %>%
addPolylines(data=vtgeojson(), color="red")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)

R - Leaflet WMTS layer is not rendering

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)

Remove zoom controls from rendered leaflet map in Shiny

Leaflet provides an option, when setting up your map, to hide the zoom controls
leaflet(options = leafletOptions(zoomControl = FALSE)
However, I would like to call this option after having already created a map so that a user can download the map without the zoom controls and without me having to re-create a different version of the map from scratch.
Here's a simple version of my app at the moment:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom) %>%
### HERE ###
mapshot(file = file)
}
)
}
shinyApp(ui, server)
I'd like to be able to add a line of code where I've commented ### HERE ### that would turn off zoom controls. In my actual code the displayed map is really complex with lots of options and I wouldn't want to have all that code twice just for the sake of removing zoom controls in the initial call to leaflet().
Thanks
You can do it like so:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
m = map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom)
m$x$options = append(m$x$options, list("zoomControl" = FALSE))
mapshot(m, file = file)
}
)
}
shinyApp(ui, server)
which is updating the leaflet options after map creation. I will incorporate this in the mapshot function to optionally remove the zoomControl.

R Shiny clusterOptions not displayed on a tabPanel - conflict with rCharts?

I am sort of struggling to display clusters of positions on a tabPanel map, when on another tabPanel, a heatmap is active.
The weird thing is that when I remove the second tabPanel (heatmap) in the ui.R, then the clusters are shown ok on the first tabPanel.
If I keep the heatmap tabPanel in the ui.R and remove "clusterOptions = markerClusterOptions()" in the server.R then the positions are displayed on the first tabPanel and heat map is OK.
Here is my code so you can easily reproduce the problem :
global.R
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
library(rCharts)
Lat <- c(48.89612,48.87366,48.88739,48.88558,48.87561)
Long <- c(2.383857,2.383921,2.387161,2.386701,2.387337)
data_test <- data.frame(Lat,Long)
data_test <- ddply(data_test, .(Lat, Long), summarise, count = length(Lat))
server.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
shinyServer(function (input, output){
output$map1 <- renderLeaflet({
leaflet() %>% setView(lng = 2.3488000, lat = 48.8534100, zoom = 12) %>%
addProviderTiles('CartoDB.Positron') %>%
addTiles() %>%
addCircleMarkers(lng = data_test$Long, lat = data_test$Lat,color=
'red',
clusterOptions = markerClusterOptions())
})
output$baseMap <- renderMap({
map2 = Leaflet$new()
map2$setView(c(48.85341,2.34880,13))
map2$addParams(height = 590, width = 880, zoom = 12)
map2$set(dcom = "baseMap")
return(map2)
})
output$heatMap <- renderUI({
j <- paste0("[",data_test[,"Lat"], ",", data_test[,"Long"],
",",data_test[,"count"], "]", collapse=",")
j <- paste0("[",j,"]")
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
if (typeof heat === typeof undefined) {
heat = L.heatLayer(addressPoints, {radius:
50,blur: 20,maxZoom: 5,max: 6.0,
gradient: {0.0: 'green',0.5: 'yellow',1.0:
'red' }}),
heat.addTo(map)}
else {heat.setLatLngs(addressPoints)}", j
))))
})
})
ui.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
header <- dashboardHeader(
title = "Test Paris", titleWidth = 450
)
body <- dashboardBody(
fluidRow(
column(width = 12,
tabBox(width = 12,
id = "CartePrincipale",
tabPanel("Map of Accidents",leafletOutput("map1", height="590px")),
tabPanel("HeatMap of Accidents",
showOutput("baseMap", "Leaflet"),
tags$style(' .leaflet {height: "590px";}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput("heatMap"))
)))
)
dashboardPage(
header,
dashboardSidebar(disable = TRUE),
body)
Is there a conflict somewhere with rCharts?
Many thanks for your assistance !
Well, I finally came across the answer, thanks to a few posts and replies from Ramnath to other people issues in the website.
In the ui.r, for the second tabPanel, the trick was just to replace
showOutput("baseMap", "Leaflet")
by :
htmlOutput("baseMap")
Clusters are now displayed Ok on the first tabPanel !

Resources