将标记的纬度经度和标签提取到数据帧

Question

我正在尝试创建一个闪亮的应用程序，允许用户单击地图中的一个点，显示他们用标记单击的位置，允许他们用名称标记该点（他们输入自由文本），然后将添加的所有点的纬度、经度和标签/名称保存到 data.frame 中，可以使用下载按钮将其导出为 .csv。

我已经弄清楚了如何使用

textInput()

记录标签，并在按下 Enter 键时提交标签（使用我从另一个 S/O 帖子复制的 java 代码）。 然后他们单击地图中要添加标记的位置，标记会添加

leafletProxy()

，并且会自动分配他们添加的最后一个标签 - 这有点笨拙，因为他们必须删除框输入下一个标签，但我稍后会尝试找出如何对其进行排序。

我的主要问题是我不知道如何提取纬度、经度和分配给

data.frame()

的标记标签。 为此，我需要了解

input$map_click

的结构，但我似乎在任何地方都找不到它 - 我知道它是一系列列表，但不知道我想要提取的三件事在哪里。 理想情况下，我还想在地图下方的 Shiny 应用程序中显示表格，并在每次添加点时使用新行更新它。

更一般地说，当涉及到 Shiny 时，我仍然是一个新手，我想了解如何在开发过程中在我的 r 控制台中基于用户交互查看应用程序中创建的内容的结构（例如在这个中）案例如何在我的 r 环境中保存

input$map_click

的副本，以便我可以检查它）。

这是一些示例代码：

# Load libraries -------------------------------------------------------

# Check if pacman is installed, install if not:
if (!require("pacman")) install.packages("pacman")

# Use pacman::p_load to load required packages:
pacman::p_load(shiny, 
               DT,
               here, 
               rio, 
               dplyr,
               sf,
               leaflet)

# Create UI ------------------------------------------------------------

ui <- fluidPage(
  
  # Create a title for the page:
  title = "Localisation des nouveau quartiers" ,
  
  # Place title in the centre:
  position = "static-top",
  
  # Add extra javascript to record when enter key is pressed:
  tags$script('
  $(document).on("keyup", function(e) {
  if(e.keyCode == 13){
    Shiny.onInputChange("keyPressed", Math.random());
    }
  });
  '),

  # Set output as leaflet map:
  leafletOutput("map"),
  
  # Create text box for GPS point label:
  textInput(inputId = "nom_du_point",
            label = "Proposer un nom pour votre nouveau quartier",
            value = "",
            width = "100%"), 
  
  # Add table of coordinates:
  DTOutput(outputId = "quartier_centroids")
  
)

server <- function(input, output, session) {
  
  # Render the leaflet map:
  output$map <- renderLeaflet(
    
    leaflet() %>% 
      # Add open street map (default base layer)
      addTiles(options = tileOptions(maxZoom = 18))
     
  )
  
  
  # Record label entered by user:
  gpslabel <- reactiveVal()
  
  observeEvent(input[["keyPressed"]], {
    
    gpslabel(input[["nom_du_point"]])
    
    # Clear the text input to allow for a new label:
    updateTextInput(session, 
                    inputId = "service", 
                    value = "")
    
  })
  

  # Add new markers to map by user clicking:
  observeEvent(input$map_click, {
    
    # Add coordinates on click:
    click <- input$map_click

    # Add marker and label to the map using coordinates and text entry:
    leafletProxy('map') %>% 
      addMarkers(lng = click$lng, 
                 lat = click$lat, 
                 label = gpslabel()) 
    
    # Add table showing results under map:
    output$quartier_centroids <- renderDT({
      
      DT::datatable(click, editable = TRUE)
      
    })
    
    
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

请注意，此代码允许我为某个点添加标签/名称，然后在地图上放置一个图钉，该图钉会自动为其分配最后一个标签。 但表格没有显示在底部，并给了我这个错误：

Error: data must be 2-dimensional (e.g. data frame or matrix)

在地图上注册标签和标记后，在我的 R 控制台中，我获得以下详细信息：

List of 3
 $ lat   : num 19.1
 $ lng   : num -72.3
 $ .nonce: num 0.133
Warning: Error in DT::datatable: 'data' must be 2-dimensional (e.g. data frame or matrix)
  108: stop
  107: DT::datatable
  106: exprFunc [#58]
  105: widgetFunc
  104: ::
htmlwidgets
shinyRenderWidget
  103: func
   90: renderFunc
   89: renderFunc
   85: renderFunc
   84: output$quartier_centroids
    3: runApp
    2: print.shiny.appobj
    1: <Anonymous>

我假设这是因为

click

是一个列表，我不知道要访问列表的哪些部分来获取纬度、经度和标签。

编辑：

在上面的代码中，我首先尝试将

click

对象放入表格中，但我真正想做的是将标记详细信息放入表格中，因为这也将包括分配的标签 - 这是我不知道该怎么做。

Answer 1

将经度和纬度保存在可下载的表格中

标记点击的经度和纬度

你确实答对了那部分。您的应用程序在单击的经度和纬度处正确创建了一个标记，但由于 leaflet.js 的问题，标记图标没有显示。

按照here的建议，您可以依靠函数

addAwesomeMarkers

并指定您选择的标记来修复它。

将点击信息存储在可下载的表格中

这里缺少的关键部分是您的表必须是响应式。有多种方法可以实现这一目标。一个简单的方法是使用

reactiveVal

，就像您对

gpslabel

所做的那样。

然后您可以使用

downloadHandler

为表格生成下载按钮。

library(DT)
library(shiny)
library(leaflet)

icon_url <- "https://raw.githubusercontent.com/rstudio/leaflet/main/docs/libs/leaflet/images/marker-icon.png"
tab <- na.omit(data.frame(longitude = NA_real_, latitude = NA_real_))

ui <- fluidPage(leafletOutput("map"), 
                DTOutput("tab"),
                downloadButton("download", "Download csv"))

server <- function(input, output, session) {
  
  tab <- reactiveVal(tab)
  
  output$map <- renderLeaflet(leaflet() %>% 
                                setView(-1.679272, 48.111368 , 12) %>%
                                addTiles(options = tileOptions(maxZoom = 18)))
  
  observeEvent(input$map_click, {
    
    leafletProxy('map') %>% 
      addAwesomeMarkers(lng = input$map_click$lng, 
                        lat = input$map_click$lat, 
                        icon = makeAwesomeIcon(icon_url))
    
    tab(rbind(tab(), data.frame(longitude = input$map_click$lng, 
                                latitude = input$map_click$lat)))
    
  })
  
  output$tab <- renderDT({datatable(tab())})
  
  output$download <- downloadHandler(
    filename = "quartiers.csv",
    content = function(file) {write.csv(as.data.frame(tab()), file, row.names = F)}
  )
}

shinyApp(ui = ui, server = server)

以自由文本形式输入标签

正如您所承认的，用户如何在此处输入标签并不是很实用。这种方法的主要问题是文本输入与点击无关。我建议通过使文本输入小部件出现在弹出窗口中来强制每个标签与给定的点击关联。

包

shinyalert

可以轻松实现：

library(DT)
library(shiny)
library(leaflet)
library(shinyalert)

icon_url <- "https://raw.githubusercontent.com/rstudio/leaflet/main/docs/libs/leaflet/images/marker-icon.png"
tab <- na.omit(data.frame(longitude = NA_real_, latitude = NA_real_, label = NA_character_))

ui <- fluidPage(useShinyalert(),
                leafletOutput("map"), 
                DTOutput("tab"),
                downloadButton("download", "Download csv"))

server <- function(input, output, session) {
  
  tab <- reactiveVal(tab)
  
  output$map <- renderLeaflet(leaflet() %>% 
                                setView(-1.679272, 48.111368 , 12) %>%
                                addTiles(options = tileOptions(maxZoom = 18)))
  
  observeEvent(input$map_click, {
    
    shinyalert(html = TRUE, showConfirmButton = F,
               text = tagList(HTML(paste0("Proposition :<br>")), 
                              textInput("prop", ""),
                              actionButton("enter", "Valider")))
  })
  
  observeEvent(input$enter, {
    
    leafletProxy('map') %>% 
      addAwesomeMarkers(lng = input$map_click$lng, 
                        lat = input$map_click$lat, 
                        icon = makeAwesomeIcon(icon_url),
                        label = input$prop)
    
    tab(rbind(tab(), data.frame(longitude = input$map_click$lng, 
                                latitude = input$map_click$lat,
                                label = input$prop)))
  })
  
  output$tab <- renderDT({datatable(tab())})
  
  output$download <- downloadHandler(
    filename = "quartiers.csv",
    content = function(file) {write.csv(as.data.frame(tab()), file, row.names = F)}
  )
}

shinyApp(ui = ui, server = server)