如何用tmap包与R Shiny实现点击交互式地图添加点位？

完全可以实现地图点击获取经纬度并添加点位的功能，结合leaflet的Shiny交互特性就能轻松做到。以下是修改后的完整代码，核心是利用leaflet的点击事件监听，将点击位置的坐标同步到输入框，再配合原有的添加逻辑完成点位新增：

library(dplyr)
library(shiny)
library(leaflet)
library(sf)

dat <- data.frame(
  lat = c(48.7323,48.7308,48.7301,48.7276,48.7246,48.7323,48.7211),
  long = c(-122.4928,-122.4940,-122.4942,-122.4939,-122.4958,-122.4975,-122.4946),
  species = c("Apple", "Apple","Pear", "Plum","Fig", "Plum","Pear"),
  status = rep("Confirmed",7)
)

ui <- fluidPage(
  titlePanel("Public Fruit Trees"),
  sidebarLayout(
    sidebarPanel(
      numericInput(inputId = "lat",
                   label = "Latitude DD",
                   value = 48.7211,step = 1e-3),
      numericInput(inputId = "long",
                   label = "Longitude DD",
                   value=-122.4942,step = 1e-3),
      selectInput(inputId = "species", label = "Species",
                  choices = c("Apple","Pear","Fig","Peach","Other")),
      actionButton(inputId = "addObservation",
                   label = "Add tree to database")
    ),
    mainPanel(
      leafletOutput(outputId = "leafletMap"), # 替换为leaflet输出
      DT::dataTableOutput("updatedData"),
    )
  )
)

server <- function(input, output, session) {
  theData <- reactiveValues(dat = dat)

  # 渲染leaflet地图
  output$leafletMap <- renderLeaflet({
    dat2plot <- st_as_sf(theData$dat, coords = c("long","lat"), crs=st_crs("EPSG:4326"))
    
    leaflet(dat2plot) %>%
      addTiles() %>% # 添加默认底图
      setView(lng = -122.494, lat = 48.728, zoom = 15) %>%
      addCircleMarkers(
        color = ~factor(species),
        opacity = 0.8,
        radius = 6,
        popup = ~paste("Species:", species, "<br>Status:", status)
      ) %>%
      addLegend("topright", pal = colorFactor(c("red","blue","green","orange","gray"), domain = c("Apple","Pear","Fig","Peach","Other")), 
                values = ~species, title = "Tree Species")
  })

  # 监听地图点击事件，更新输入框坐标
  observeEvent(input$leafletMap_click, {
    click <- input$leafletMap_click
    updateNumericInput(session, "lat", value = click$lat)
    updateNumericInput(session, "long", value = click$lng)
  })

  # 原有添加逻辑+实时刷新地图
  observeEvent(input$addObservation,{
    to_add <- data.frame(
      lat = input$lat,
      long = input$long,
      species = input$species,
      status = "Unconfirmed" # 修正拼写错误
    )
    theData$dat <- rbind(theData$dat,to_add)
    # 仅新增标记，无需重绘整个地图
    leafletProxy("leafletMap", session) %>%
      addCircleMarkers(
        lat = input$lat,
        lng = input$long,
        color = switch(input$species,
                      "Apple" = "red",
                      "Pear" = "blue",
                      "Fig" = "green",
                      "Peach" = "orange",
                      "Other" = "gray"),
        opacity = 0.8,
        radius = 6,
        popup = paste("Species:", input$species, "<br>Status: Unconfirmed")
      )
  })

  output$updatedData <- DT::renderDataTable(theData$dat)
}

shinyApp(ui = ui, server = server)

关键修改说明 #

• 替换地图组件：将tmapOutput改为leafletOutput，leaflet对Shiny交互事件的支持更直接成熟，便于监听点击动作
• 监听点击事件：通过input$leafletMap_click获取地图点击的坐标，用updateNumericInput同步到侧边栏的纬度/经度输入框
• 优化地图更新：使用leafletProxy在添加新点位时仅新增标记，无需重新渲染整个地图，提升响应速度
• 修正细节问题：将原代码中的拼写错误"Uncomfirmed"改为"Unconfirmed"

内容的提问来源于stack exchange，提问作者Finn Tobias