Save leaflet map in Shiny - r

I have created a leaflet map in a Shiny application. Now I need a download button, so that the user can download the currently shown map including all markers, polygons etc. as a pdf file.
I have found this solution how to save a leaflet map in R: How to save Leaflet in R map as png or jpg file?
But how does it work in Shiny? I kept the example code simple, but think of it, as if there were a lot of changes to the map via leafletProxy() before the user wants to save the map as a pdf.
This is my try, but it's not working.
server.R
library(shiny)
library(leaflet)
library(devtools)
install_github("wch/webshot") # first install phantomjs.exe in your directory
library(htmlwidgets)
library(webshot)
server <- function(input, output){
output$map <- renderLeaflet({
leaflet() %>% addTiles()
})
observe({
if(input$returnpdf == TRUE){
m <- leafletProxy("map")
saveWidget(m, "temp.html", selfcontained = FALSE)
webshot("temp.html", file = "plot.pdf", cliprect = "viewport")
}
})
output$pdflink <- downloadHandler(
filename <- "map.pdf",
content <- function(file) {
file.copy("plot.pdf", file)
}
)
}
ui.R
ui <- fluidPage(
sidebarPanel(
checkboxInput('returnpdf', 'output pdf?', FALSE),
conditionalPanel(
condition = "input.returnpdf == true",
downloadLink('pdflink')
)
),
mainPanel(leafletOutput("map"))
)

I have updated my previous answer to make it more clear and illustrate how to use mapshot from package mapview.
Moreover, following Jake's question below, I noticed that it might be necessary to specify a link to a tile (within addTiles), or the map might be downloaded with a grey background.
Server
server = function(input, output){
mymap <- reactive({
# here I have specified a tile from openstreetmap
leaflet() %>% addTiles('http://{s}.tile.openstreetmap.de/tiles/osmde/{z}/{x}/{y}.png')
})
output$map <- renderLeaflet({
mymap()
})
# function with all the features that we want to add to the map
myfun <- function(map){
addCircles(map,12.5,42,radius=500) %>% addMarkers(12,42,popup="Rome")
}
observe({
leafletProxy("map") %>% myfun()
})
# map that will be downloaded
mapdown <- reactive({
# we need to specify coordinates (and zoom level) that we are currently viewing
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
mymap() %>% myfun() %>% setView(lng = (lngRng[1]+lngRng[2])/2, lat = (latRng[1]+latRng[2])/2, zoom = input$map_zoom)
})
output$map_down <- downloadHandler(
filename = 'mymap.pdf',
content = function(file) {
# temporarily switch to the temp dir, in case you do not have write
# permission to the current working directory
owd <- setwd(tempdir())
on.exit(setwd(owd))
# using saveWidget and webshot (old)
saveWidget(mapdown(), "temp.html", selfcontained = FALSE)
webshot("temp.html", file = file, cliprect = "viewport")
# using mapshot we can substitute the above two lines of code
# mapshot(mapdown(), file = file, cliprect = "viewport")
}
)
}
UI
ui <- fluidPage(
sidebarPanel(
checkboxInput('returnpdf', 'output pdf?', FALSE),
conditionalPanel(
condition = "input.returnpdf == true",
downloadButton('map_down')
)
),
mainPanel(leafletOutput("map"))
)

Related

R Shiny - Add markers to leaflet map using file input

I am attempting to add markers to a map based on coordinates uploaded by a user. I am having trouble storing the file input as a data frame and then passing the coordinates from the data frame to the proxy map to add markers.
ui <- fluidPage(
titlePanel(title = "My Dashboard"),
sidebarLayout(
fileInput(inputId = "file",
label = "File upload"),
mainPanel(
leafletOutput("mymap")
)
)
)
server <- function(input, output) {
m <- leaflet() %>%
setView(lng = -71.0589,
lat = 42.3601,
zoom = 12) %>%
addProviderTiles(providers$CartoDB.Positron)
output$mymap <- renderLeaflet(m)
observe({
input$file
df <- read.csv('input$file$datapath')
proxy <- leafletProxy("mymap", data = df)
proxy %>% addMarkers(~long, ~lat)
})
shinyApp(ui = ui, server = server)
You were almost there, just change the way how you are reading the file to
observe({
req(input$file)
df <- read.csv(input$file$datapath)
proxy <- leafletProxy("mymap", data = df)
proxy %>% addMarkers(~long, ~lat)
})
That is removing the quotes '. The req makes sure that no error is thrown when there is no upload yet. When uploading a csv make sure that there are columns labeled long and lat.

Downloading wordcloud2 output as png/jpg on shiny

I am trying to download output from wordcloud2 on shiny.
My code is as below:
library(shiny)
library(htmlwidgets)
library(webshot)
ui <- shinyUI(fluidPage(mainPanel(
wordcloud2Output("wordcl"),
downloadButton(outputId = "savecloud"),
downloadButton(outputId = "savecloud2")
)))
server <- shinyServer(function(input, output, session) {
wordcl <- reactive ({
wordcloud2(demoFreq, color = "random-light", backgroundColor = "grey")
})
output$wordcl <- renderWordcloud2({ wordcl() })
##### SOLUTION 1 #########
output$savecloud <- downloadHandler(
filename = "word.png",
content = function(cloud) {
file.copy(wordcl(), cloud)
})
##### SOLUTION 2 ##########
output$savecloud2 <- downloadHandler(
saveWidget(wordcl(), file="temp.html", selfcontained = F),
webshot("temp.html", file = "word2.png",
cliprect = "viewport")
)
})
shinyApp(ui = ui, server = server)
I have tried two styles using downloadhandler as shown in the code but they return empty results.
Any insight on why they downloadhandler doesn't work or redirection on how best to effect the download function will be appreciated.
I managed to make my download work by using an example of download handler function posted on LeafletMaps here: Why is webshot not working with leaflets in R shiny?
My updated code is as below:
library(shiny)
library(htmlwidgets)
library(webshot)
library(wordcloud2)
#webshot::install_phantomjs()
ui <- shinyUI(fluidPage(mainPanel(
wordcloud2Output("wordcl"),
downloadButton(outputId = "savecloud")
)))
server <- shinyServer(function(input, output, session) {
wordcl <- reactive ({
wordcloud2(demoFreq, color = "random-light", backgroundColor = "grey")
})
output$wordcl <- renderWordcloud2({
wordcl()
})
output$savecloud <- downloadHandler(
filename = paste("wordcloud", '.png', sep=''),
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
saveWidget(wordcl(), "temp.html", selfcontained = FALSE)
webshot("temp.html", delay =15, file = file, cliprect = "viewport")
})
})
shinyApp(ui = ui, server = server)
The solution given on the link seems to combine the solutions I was trying to implement in my original post.
The only issue is that it does not work when the app is deployed on shiny.io

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.

Shiny app path error

I am trying to create an shiny app that uploads an image and then does OCR. The upload part seems to work but the OCR gives an error "Error: path must be URL, filename or raw vector" Any help is appreciated.
On another but related note, is anyone familiar with the implementation of MSER algorithm in R? I know I can call the python implementation through R.
library(shiny)
library(magick)
library(magrittr)
ui <- shinyUI(fluidPage(
titlePanel('Test Code'),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an Invoice',
multiple = FALSE,
accept=c('image/png', 'image/jpeg')),
imageOutput('images')
),
mainPanel(
textOutput('extracted')
)
)
))
server <- shinyServer(function(input, output) {
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$extracted<-renderText({
text <- image_read(list(src = files()$datapath[1])) %>%
image_resize("2000") %>%
image_convert(colorspace = 'gray') %>%
image_trim() %>%
image_ocr()
cat(text)
})
output$images <- renderImage({
list(src = files()$datapath[1],
height = 800,
width = 600,
alt = "Upload an Invoice in an image format")
}, deleteFile = FALSE)
}
)
shinyApp(ui=ui,server=server)
You need to fix output$extracted as follows:
output$extracted <- renderText({
if (is.null(input$files)) return(NULL)
# Fix file path
text <- image_read(files()$datapath[1]) %>%
image_resize("2000") %>%
image_convert(colorspace = 'gray') %>%
image_trim() %>%
image_ocr()
# Print to the console
cat(text)
# Return value to be rendered in Shiny
text
})

Shiny R leaflet AddMarkers NULL value error

I am trying to create a leaflet Shiny app however I keep getting the Warning: Error in derivePoints: addMarkers requires non-NULL longitude/latitude values Error. I have attached the code herewith. Also, a screenshot of the input data files and links to download.
DataBooks.csv
GPSBook.csv
Code:
library(shiny)
library(leaflet)
Location_levels=list(Institutional=0, Provincial=1, National=2, International=3)
DataBook <- read.csv("~/R_Projects/TNL_Network/DataBook.csv", comment.char="#")
GPSBook <- read.csv("~/R_Projects/TNL_Network/GPSBook.csv", comment.char="#")
## Create content for the popups in the markers
popUpContent <- function(ins_id){
subs<-subset(DataBook, Institute_id==ins_id)
name <- subs$Institute[[1]]
return(name[[1]])
}
## Get unique markers based on the location type selected. This function calls the popup content function above and returns a dataframe
markerData <- function(location){
subs1<-subset(DataBook, Location_level<=Location_levels[location])
unique_ins_ids<-levels(factor(subs1$Institute_id))
mdata.list <- vector("list", length(unique_ins_ids))
for(i in 1:length(unique_ins_ids)){
mdata.list[[i]] <- list(subset(GPSBook, Institute_id==unique_ins_ids[i])["Longitude"][[1]], subset(GPSBook, Institute_id==unique_ins_ids[i])["Latitude"][[1]],
as.character(popUpContent(unique_ins_ids[i])))
}
solution <- do.call('rbind', mdata.list)
dataf<-data.frame(solution)
colnames(dataf)<-c("lat", "long", "Msg") ## I ihave mixed up the origincal longitude and latitude. I invert it here.
return(dataf)
}
## Function to create initial data.
initData <- function(){
return(markerData("International"))
}
init_dataset <- initData()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
radioButtons(inputId = "radio", label = "", choices = as.list(levels(DataBook$Location)), selected = "International")
)
server <- function(input, output, session) {
observe({
proxy <- leafletProxy("mymap", data = markerData(input$radio))
proxy %>% clearMarkers()
proxy %>% addMarkers()
})
output$mymap <- renderLeaflet({
leaflet(data = markerData(input$radio)) %>% addTiles() %>%
addMarkers()
})
}
shinyApp(ui, server)
Thanks a lot for the help.
Links to files.
https://drive.google.com/open?id=0B-TWCTRv7UM1bnVpWEIxTnB2d28
https://drive.google.com/open?id=0B-TWCTRv7UM1cjBxNnlhR2ZXc0U
I hope I have understood you intention. If yes this can be simplified a lot.
This is how I would do it. (just change back to the correct directories where your csv files are). The code:
library(shiny)
library(leaflet)
DataBook <- read.csv("./data/DataBook.csv", comment.char="#")
GPSBook <- read.csv("./data/GPSBook.csv", comment.char="#")
names(GPSBook) <- names(GPSBook)[c(1,2,4,3)]
ui <- fluidPage(
leafletOutput("mymap"),
p(),
radioButtons(inputId = "radio", label = "", choices = as.list(levels(DataBook$Location)), selected = "International")
)
server <- function(input, output, session) {
location <- reactive({
tmp <- subset(DataBook, Location_level <= Location_levels[input$radio])
uniqueIds <- unique(tmp$Institute_id)
tmpGps <- subset(GPSBook, Institute_id %in% uniqueIds)
})
observe({
proxy <- leafletProxy("mymap", data = location())
proxy %>% clearMarkers()
proxy %>% addMarkers(popup = ~as.character(Name))
})
output$mymap <- renderLeaflet({
leaflet(data = GPSBook) %>% addTiles() %>%
addMarkers(popup = ~as.character(Name))
})
}
shinyApp(ui, server)
In your original code the function was creating a list so the data was not prepared as leaflet would expect them to be.

Resources