R Shiny – Рисуйте с помощью Leaflet и экспортируйте

Вопрос или проблема

library(sf)
library(dplyr)
library(shiny)
library(leaflet)
library(shinyalert)
library(leaflet.extras)

ui <- fluidPage(
  fluidRow(
    column(width = 2,
           br(),
           h4("Панель управления"),
           hr(),
           textInput(inputId = "name", label = "Название функции/полигона:"),
           hr(),
           radioButtons(inputId = "filetype", label = "Тип вывода:", choices = c("Shapefile","GEOJson"), selected = NULL),
           textInput(inputId = "filename", value = "", label = "Имя файла:"),
           actionButton("download","Скачать форму")
           ),
    column(width = 10, leafletOutput("map", width = "98%", height = 1000))
  )
)

server <- function(input, output, session) {

  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -117.88111674347516, lat = 33.6953612425539, zoom = 12) %>%
      addProviderTiles(providers$Esri.WorldImagery, options = providerTileOptions(noWrap = TRUE)) %>%
      addDrawToolbar()
  })

  polygon_data <- reactive({input$map_draw_new_feature$geometry$coordinates[[1]]})

  shapefile <- reactive({
    longitude = lapply(polygon_data(), `[[`, 1)
    latitude = lapply(polygon_data(), `[[`, 2)

    shp <- st_as_sf(tibble(lon = longitude, lat = latitude),
                   coords = c("lon", "lat"),
                   crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>%
      mutate(Name = input$name)

    return(shp)
  })

  observeEvent(input$download,{

    if(input$filetype == "Shapefile"){
      st_write(shapefile(), paste0("output\\", input$filename, ".shp"))
    } else {
      st_write(shapefile(), paste0("output\\", input$filename, ".geojson"))
    }

    if(input$filetype == "Shapefile"){
      st_write(sf_polygons, paste0("output\\", input$filename, ".shp"))
    } else {
      st_write(sf_polygons, paste0("output\\", input$filename, ".geojson"))
    }

    shinyalert(
      title = "Shapefile был сгенерирован.",
      text = "Теперь вы можете вернуться к карте.",
      size = "s", 
      closeOnEsc = TRUE,
      closeOnClickOutside = FALSE,
      html = FALSE,
      type = "info",
      showConfirmButton = TRUE,
      showCancelButton = FALSE,
      confirmButtonText = "ОК",
      confirmButtonCol = "#113A72",
      timer = 0,
      imageUrl = "",
      animation = TRUE
    )
  })

}

shinyApp(ui = ui, server = server)

Ответ или решение

Работа с R Shiny: Рисование с помощью Leaflet и экспорт

Введение

В данной статье мы обсудим, как развивать функциональность приложения на R Shiny, которое позволяет пользователям рисовать многоугольники на карте, а затем экспортировать их в формате Shapefile или GeoJSON. Особое внимание будет уделено объединению нескольких многоугольников в один файл, где каждая строка представляет отдельный многоугольник.

Проблема

Вам необходимо реализовать возможность добавления нескольких многоугольников на карту и экспорта их в виде одного Shapefile или GeoJSON. Описание проблемы указывает на необходимость использования реактивных значений для хранения координат многоугольников и их последующего объединения, что не является тривиальной задачей.

Решение

Следующий код представляет собой доработанный пример вашего приложения, позволяющий сохранять несколько многоугольников и экспортировать их корректно.

Шаг 1: Обновление пользовательского интерфейса

Ваша текущая версия интерфейса хороша, но мы добавим немного логики для обработки и отображения статуса добавления многоугольников.

ui <- fluidPage(
  fluidRow(
    column(width = 2,
           br(),
           h4("Control Panel"),
           hr(),
           textInput(inputId = "name", label = "Feature/Polygon Name:"),
           hr(),
           radioButtons(inputId = "filetype", label = "Output Type:", choices = c("Shapefile", "GEOJson")),
           textInput(inputId = "filename", value = "", label = "Filename:"),
           actionButton("download", "Download Shape")
           ),
    column(width = 10, leafletOutput("map", height = 800))
  )
)

Шаг 2: Обновление сервера

В серверной части вашего приложения можно внедрить следующие изменения для работы с несколькими многоугольниками:

server <- function(input, output, session) {
  features <- reactiveVal(list())  # Инициализация списка многоугольников

  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -117.88111674347516, lat = 33.6953612425539, zoom = 12) %>%
      addProviderTiles(providers$Esri.WorldImagery) %>%
      addDrawToolbar()
  })

  observeEvent(input$map_draw_new_feature, {
    req(input$map_draw_new_feature)
    new_feature <- input$map_draw_new_feature$geometry$coordinates[[1]]
    features(c(features(), list(new_feature)))  # Добавление нового многоугольника
  })

  shapefiles <- reactive({
    req(features())

    polygons_list <- lapply(features(), function(polygon) {
      lat <- unlist(lapply(polygon, `[[`, 2))
      lon <- unlist(lapply(polygon, `[[`, 1))
      st_as_sf(data.frame(Name = input$name), coords = c("lon", "lat"), crs = 4326) %>%
        summarise(geometry = st_combine(geometry)) %>%
        st_cast("POLYGON")
    })

    # Объединение всех многоугольников в один sf объект
    do.call(rbind, polygons_list)
  })

  observeEvent(input$download, {
    req(input$filename)

    if (input$filetype == "Shapefile") {
      st_write(shapefiles(), paste0("output/", input$filename, ".shp"))
    } else {
      st_write(shapefiles(), paste0("output/", input$filename, ".geojson"))
    }

    shinyalert(
      title = "Файл успешно сгенерирован.",
      text = "Вы можете вернуться к карте.",
      type = "info"
    )
  })
}

Объяснение нескольких ключевых аспектов

1. Хранение многоугольников: Мы используем reactiveVal(list()), чтобы хранить многоугольники. Каждый новый многоугольник добавляется в список при его рисовании на карте.

2. Обработка экспортируемых данных: С помощью do.call(rbind, polygons_list) объединяются все многоугольники в один объект sf. Это позволяет сохранить их как единую сущность при экспорте.

3. Пользовательский интерфейс и уведомления: Простое предупреждение выводится после успешного экспорта файла, чтобы пользователь знал о завершении операции.

Заключение

Теперь ваше приложение R Shiny может добавлять и экспортировать несколько многоугольников в формате Shapefile или GeoJSON. Эти изменения не только улучшают функциональность, но и делают ваше приложение более полезным и интуитивно понятным для пользователей. Используйте этот код как основу для дальнейшей настройки и улучшения вашего приложения, добавляя новые функции и расширяя возможности взаимодействия с картой.