Reputation: 81
I have a module with only the download button and 2 other modules, the ui and server functions to plot a map.
Now I want to implement the download button to print the map. I have tried many ways but I can't download the map in a pdf.
In my original script, I have several modules to plot several charts. I will have to be able to download all the charts in one pdf in portrait.
The download is not working. I have tried this example: https://community.rstudio.com/t/shiny-module-downloading-all-plots-into-a-single-pdf/124869
How can I download the map in a pdf?
Here is my reproducible code:
#The map UI
trade_agreement_ui <- function(id) {
ns <- NS(id)
tagList(
fluidRow(column(
8,
offset = 2,
box(
solidHeader = TRUE,
column(12, align = 'left', h4(strong("Trade Agreement"))),
br(),
column(
12,
align = 'left',
br(),
leafletOutput(outputId = ns("map1"),height = "650px", width = "100%")
),
width = 16
)
)))
}
#The map server
trade_agreement_server <- function(id) {
moduleServer(id,
function(input, output, session) {
val <- reactiveValues(map1=NULL)
output$map1 <- renderLeaflet({
val$map1 <- leaflet() %>%
addTiles(urlTemplate = "https://api.mapbox.com/styles/v1/bholee/cl75rvfqs002q14o0rwzd6oe5/tiles/{z}/{x}/{y}@2x?access_token=pk.eyJ1IjoiYmhvbGVlIiwiYSI6ImNrN2tibG9pNzAwajMzbWw4ZnlpcDNqY2wifQ.o-qJAmRdkh-McoubI4E2DA"
)
val$map1
})
val
})
}
#Main UI
ui <-
tagList(
tags$style(HTML(
paste(
"html,",
".container{
width: 100%;
margin: 0 auto;
padding: 0;
}
@media screen and (min-width: 700px){
.container{
min-width: 1850px;
max-width: 1920px;
}
}
",
sep = " "
)
)),
tags$div(
class = "container",
dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(
#UI for download
fluidRow(column(
8, offset = 2, box(
solidHeader = TRUE,
column(6, align = 'right', class = 'download_padding', downloadButton(
outputId = "download",
label = "Download Report",
class = 'download_button',
width = 150,
)
),
width = 16,
)
)),
#End of UI for download
#UI for Trade Agreements
trade_agreement_ui(id = "agreement")
#End of UI Trade Agreements
)
)
)
)
#### End Create User Interface #####
#Main Server
#### Create Server actions #####
server <- shinyServer(function(input, output, session) {
#### Trade Agreements ####
v1 <- trade_agreement_server(
id = "agreement"
)
#### Trade Agreements ####
output$download <- downloadHandler(
filename = function() {
paste0("plot.pdf")
},
content = function(file) {
pdf(file)
v1$map1
dev.off()
}
)
})
#### End create Server actions #####
#### Run application #####
shinyApp(ui, server)
#### End Run application #####
Upvotes: 0
Views: 234
Reputation: 21297
You can use a downloadHandler
to download your map - in the main server. I am not sure in your use case if you need the download button in a separate module; then you need to test it out.
library(leaflet)
library(mapview)
library(webshot)
#The map UI
trade_agreement_ui <- function(id) {
ns <- NS(id)
tagList(
fluidRow(column(
8,
offset = 2,
box(
solidHeader = TRUE,
column(12, align = 'left', h4(strong("Trade Agreement"))),
br(),
column(
12,
align = 'left',
br(),
leafletOutput(outputId = ns("map"),height = "650px", width = "100%")
),
width = 16
)
)))
}
#The map server
trade_agreement_server <- function(id) {
moduleServer(id,
function(input, output, session) {
### initial map
mymap <- reactive({
leaflet() %>%
addTiles(urlTemplate = "https://api.mapbox.com/styles/v1/bholee/cl75rvfqs002q14o0rwzd6oe5/tiles/{z}/{x}/{y}@2x?access_token=pk.eyJ1IjoiYmhvbGVlIiwiYSI6ImNrN2tibG9pNzAwajMzbWw4ZnlpcDNqY2wifQ.o-qJAmRdkh-McoubI4E2DA"
)
})
output$map <- renderLeaflet({ mymap() })
# return(mymap) ## does not work
user_created_map <- reactive({
# call the initial Leaflet map
mymap() %>%
# store the view based on UI
setView( lng = input$map_center$lng
, lat = input$map_center$lat
, zoom = input$map_zoom
)
}) # end of creating user.created.map()
return(user_created_map)
})
}
#Main UI
ui <-
tagList( #shinyjs::useShinyjs(),
# tags$head(# the javascript is checking the screen resolution to adapt the display
# tags$script(src = "javascripts.js")),
tags$style(HTML(
paste(
"html,",
".container{
width: 100%;
margin: 0 auto;
padding: 0;
}
@media screen and (min-width: 700px){
.container{
min-width: 1850px;
max-width: 1920px;
}
}
",
sep = " "
)
)),
tags$div(
class = "container",
dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(
#
# tags$head(
# tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
# ),
fluidRow(column(4,""), column(2, offset = 1,
downloadBttn("savePDF",
HTML(" Download Report"),
style = "fill",
color = "warning",
size = "lg",
block = TRUE,
no_outline = TRUE
)
)),
#UI for download
#reporter_download_ui(id = "reporterdownload"),
#End of UI for download
#UI for Trade Agreements
trade_agreement_ui(id = "agreement")
#End of UI Trade Agreements
)
)
)
)
#### End Create User Interface #####
#Main Server
#### Create Server actions #####
server <- shinyServer(function(input, output, session) {
#### Trade Agreements ####
mymap <- trade_agreement_server(id = "agreement")
#### Trade Agreements ####
# create the output file name
# and specify how the download button will take
# a screenshot - using the mapview::mapshot() function
# and save as a PDF
output$savePDF <- downloadHandler(
filename = function(){
paste0('mymap', Sys.Date(), '.pdf', sep='')
},
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))
saveWidget(mymap(), "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")
}
)
})
#### End create Server actions #####
#### Run application #####
shinyApp(ui, server)
Upvotes: 0