Here is a quick example of a shiny app that allows the user to select data to display on a map and to download slides containing this map. It works locally but not when deployed. It seems related to PhantomJS but i can't figure out if there is a solution? Or maybe a workaround to the use of mapshot?
library(sf)
library(leaflet)
library(officer)
library(shiny)
library(mapview)
library(webshot)
library(shinyWidgets)
library(RSelenium)
temp_folder <- tempfile()
onStop(function() {
cat("Removing Temporary Files and Folders\n")
unlink(temp_folder, recursive=TRUE)
})
dir.create(temp_folder)
stations_sf <- read.csv('https://assets.datacamp.com/production/course_6355/datasets/stations_data.csv') %>%
st_as_sf(coords = c("longitude", "latitude")) %>%
st_sf(crs = 4326)
GeneratePowerpoint<-function(temp_folder,station){
vwidth<-1350
vheight<-880
map<-leaflet(data = stations_sf,options = leafletOptions(zoomControl = FALSE)) %>% addTiles() %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
addMarkers()
tempmap<-file.path(temp_folder,'Map.png')
file.copy(mapshot(map,file=file.path(temp_folder,'Map.png'),vwidth = vwidth, vheight = vheight),tempmap, overwrite=TRUE)
example_pptx <- system.file(package = "officer", "doc_examples/example.pptx")
my_pres<-read_pptx(example_pptx) %>%
add_slide(layout = "Image avec légende", master = "My Theme") %>%
ph_with(value = external_img(tempmap), location = ph_location_label(ph_label = "Espace réservé pour une image 2"))
return(my_pres)
}
# Define UI for application that draws a histogram
ui <- fluidPage(
tags$head(
tags$style(type = "text/css", "#map {height: calc(85vh - 80px) !important;}"),
),
# Application title
titlePanel("Maps on slides"),
div(style="display: inline-block;vertical-align:center; width: 150px;",
pickerInput('Station',
"Choose stations()",
unique(stations_sf$station),
selected=unique(stations_sf$station),
multiple=TRUE)),
div(style="display: inline-block;vertical-align:center; width: 150px;",downloadButton("downloadSlides", "Download slides")),
leafletOutput("map")
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
if (is.null(suppressMessages(webshot:::find_phantom()))) { webshot::install_phantomjs() }
output$downloadSlides <- downloadHandler(
filename = function() {
"Slides.pptx"
},
content = function(file) {
example_pp<-GeneratePowerpoint(temp_folder,station())
print(example_pp, target = file)
}
)
station<-reactive({
stations_sf %>% dplyr::filter(station %in% input$Station)
})
output$map<-renderLeaflet({
leaflet(data = station(),options = leafletOptions(zoomControl = FALSE)) %>% addTiles() %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
addMarkers()
})
}
shinyApp(ui = ui, server = server)