Блог

У меня есть несколько больших шейп-файлов, для которых я хочу выполнить некоторый анализ пересечения с использованием пользовательского ввода на карте листовки. На моей блестящей странице отображается карта, на которой пользователь может нарисовать полигон, и я хочу посмотреть, пересекает ли этот полигон любой из двух шейп-файлов. Я создал рабочую версию этого, в которой сервер считывает шейп-файлы каждый раз, когда пользователь подключается к серверу, но, очевидно, это не очень удобно для пользователя. Итак, я пытался переместить чтение шейп-файла в глобальные переменные, которые сервер загружает один раз, и пользователю просто нужно запустить intersect. Я пока пропущу публикацию своих 3 строк пользовательского интерфейса, но это приложение работает локально, только когда я запускаю его на выделенном сервере Shiny, который выходит из строя после того, как пользователь «закрывает» полигон. У меня такое чувство, что это проблема с объявлениями глобальных переменных, но файл журнала не генерируется, поэтому мне очень сложно его отлаживать.

App.R

 library(shiny)

source("/ui.R")
source("/server.R")

shpfile1 <- st_read("path_to_shpfile1")
shpfile2 <- st_read("path_to_shpfile2")

ui <- ui()
server <- server()

shinyApp(ui = ui, server = server)
 

Server.R

 # a number of libraries

server <- function(input, output, session) {
    output$s1 <- renderText({"Define project area..."})
    output$s2 <- renderText({"Define project area..."})

    print("Reading New Jersey boundary...")
    mapStates = map("state", "New Jersey", fill = FALSE, plot = FALSE)
    
    output$map <- renderLeaflet({
        leaflet(data = mapStates) %>% addTiles() %>% addPolygons(fillColor = topo.colors(10, alpha=0.8), stroke=FALSE) %>%
        addDrawToolbar(targetGroup = "projectArea", 
                       rectangleOptions = F, 
                       polylineOptions = F, 
                       markerOptions = F, 
                       circleMarkerOptions = F,
                       editOptions = editToolbarOptions(edit = FALSE, remove = TRUE, selectedPathOptions = selectedPathOptions()), 
                       circleOptions = F)
    })
    
    observeEvent(input$drawPoints, {
        proxy %>% clearShapes()
        for (i in seq_along(data)) {
            proxy %>% addPolygons(
                data[[i]][,"lon"],
                data[[i]][,"lat"],
                layerId=i,
                opacity=0.4,
                color = c('red','green')[i]
            )
            Sys.sleep(2)  # - this is to see first (red) polygon
        }
    })
    
    observeEvent(input$map_draw_new_feature, {
        withProgress(message = "Please wait...", value = 0, {
            # capture project area and convert to usable format for intersecting
            feat <- input$map_draw_new_feature
            coords <- unlist(feat$geometry$coordinates)
            coords <- matrix(coords, ncol=2, byrow=TRUE)
            poly <- st_sf(st_sfc(st_polygon(list(coords))), crs = " proj=longlat  datum=WGS84")
            
            # intersect project area with constraint layers
            incProgress(1/3, detail = "Analyzing shapefile1...")
            i_shp1 <- st_intersects(poly, shpfile1)
            c_shp1 <- sapply(i_shp1, length)
            incProgress(2/3, detail = "Analyzing shapefile2...")
            i_shp2 <- st_intersects(poly, shpfile2)
            c_shp2 <- sapply(i_shp2, length)
            
            if(c_streams > 0) {
                output$s1 <- renderText({"does intersect shapefile 1"})
            } else {
                output$s1 <- renderText({"does not intersect shapefile 1"})
            }
    
            if(c_wetlands > 0) {
                output$s2 <- renderText({"does intersect shapefile 2"})
            } else {
                output$s2 <- renderText({"does not intersect shapefile 2"})
            }
        })
    })

    
}