r - R闪亮和R会话环境
问题描述
有没有办法在不下载的情况下从 R 闪亮应用程序（本地运行）获取对象到 R 会话环境？类似于将信息从 R Shiny 打印到控制台但带有对象。下面是一个让用户绘制几何图形（多边形）然后将该多边形下载到 zip 文件的应用程序；但是，对象 (sf) 已经在 R 闪亮环境中，如果他们不必下载 zip 然后解压缩然后在当前 R 会话环境中使用，这将是一个很好的用户体验。我没有想法和想法......谢谢。
library(shiny)
library(leaflet)
library(sf)
library(zip)
library(leaflet.extras)
library(leafem)
viz_A <- function() {
grp <- c("USGS Topo", "USGS Imagery Only", "USGS Imagery Topo",
"USGS Shaded Relief", "Hydrography")
att <- paste0("<a href='https://www.usgs.gov/'>",
"U.S. Geological Survey</a> | ",
"<a href='https://www.usgs.gov/laws/policies_notices.html'>",
"Policies</a>")
GetURL <- function(service, host = "basemap.nationalmap.gov") {
sprintf("https://%s/arcgis/services/%s/MapServer/WmsServer", host, service)
}
map <- leaflet::leaflet()
map <- leaflet::addWMSTiles(map, GetURL("USGSTopo"),
group = grp[1], attribution = att, layers = "0")
map <- leaflet::addWMSTiles(map, GetURL("USGSImageryOnly"),
group = grp[2], attribution = att, layers = "0")
map <- leaflet::addWMSTiles(map, GetURL("USGSImageryTopo"),
group = grp[3], attribution = att, layers = "0")
map <- leaflet::addWMSTiles(map, GetURL("USGSShadedReliefOnly"),
group = grp[4], attribution = att, layers = "0")
opt <- leaflet::WMSTileOptions(format = "image/png", transparent = TRUE)
map <- leaflet::addWMSTiles(map, GetURL("USGSHydroCached"),
group = grp[5], options = opt, layers = "0")
map <- leaflet::hideGroup(map, grp[5])
opt <- leaflet::layersControlOptions(collapsed = TRUE)
map <- leaflet::addLayersControl(map, baseGroups = grp[1:4],
overlayGroups = grp[5], options = opt)
map %>%
leafem::addMouseCoordinates(epsg = "EPSG:4326", proj4string = "+proj=utm +zone=32 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")
}
shiny::shinyApp(
ui = shiny::fluidPage(leaflet::leafletOutput('aoi'),
shiny::textInput('export_filename', label = 'Filename'),
shiny::downloadButton("downloadData", label = "Download")
),
server = function(input, output, session) {
output$aoi <- leaflet::renderLeaflet({
viz_A() %>% leaflet::setView(lat = 48.91167, lng = -114.90246, zoom = 4) %>%
leafem::addMouseCoordinates(epsg = "EPSG:4326", proj4string = "+proj=utm +zone=32 +ellps=WGS84 +datum=WGS84 +units=m +no_defs") %>%
leaflet.extras::addDrawToolbar(polylineOptions = F, circleOptions = T, markerOptions = T,
circleMarkerOptions = F, polygonOptions = T)
})
shiny::observeEvent(input$aoi_draw_new_feature, {
feat <- input$aoi_draw_new_feature
coords <- unlist(feat$geometry$coordinates)
coords <- matrix(coords, ncol = 2, byrow = T)
poly <- sf::st_sf(sf::st_sfc(sf::st_polygon(list(coords))), crs = sf::st_crs(4326)) %>% sf::st_as_sf()
maps <- shiny::reactive(poly)
leaflet::leafletProxy('aoi') %>% leafem::addMouseCoordinates(epsg = "EPSG:4326", proj4string = "+proj=utm +zone=32 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")
map_update <- shiny::reactive({ viz_A() %>% leafem::addMouseCoordinates(epsg = "EPSG:4326", proj4string = "+proj=utm +zone=32 +ellps=WGS84 +datum=WGS84 +units=m +no_defs") %>%
leaflet::addPolygons(data = maps() )})
output$aoi <- leaflet::renderLeaflet({
map_update() %>%
leaflet.extras::addDrawToolbar(polylineOptions = F, circleOptions = T, markerOptions = T,
circleMarkerOptions = T, polygonOptions = T)
})
output$downloadData <- shiny::downloadHandler(
filename = function() {
paste0(input$export_filename, ".zip")
},
content = function(file) {
tmp.path <- dirname(file)
name.base <- file.path(tmp.path, input$export_filename)
name.glob <- paste0(name.base, ".*")
name.shp <- paste0(name.base, ".shp")
name.zip <- paste0(name.base, ".zip")
sf::st_write(maps(), dsn = name.shp, layer = "shpExport",
driver = "ESRI Shapefile", quiet = TRUE, delete_dsn = T)
zip::zipr(zipfile = name.zip, files = Sys.glob(name.glob))
shiny::req(file.copy(name.zip, file))
})
}
)
}
)