R/Shiny + leaflet で地図上にマップキーとメモを書く

16666 ワード
R leaflet Shiny R テキストリンク

はじめに

R/Shiny + leaflet で地図上にメモを残す機能を実装してみた。実装したのは以下の機能。
- マップ上を選択すると、キーが一時的に配置。
- 置きたい位置で [Place] を押すと、置いたキーの緯度経度をテーブルに登録。
- 表示されるモーダルにメモを記入し、モーダルの [OK] を押すとメモ付きのキーが固定。
- キーを選択すると、ポップアップにメモを表示。
- キーを選択して、[Delete] を押すと削除。

ソースコード

具体的なコードは以下。

mapkey.R
library(shiny)
library(leaflet)
library(leaflet.extras2)

ui <- fluidPage(
  leafletOutput(outputId="map", height="400"),
  actionButton(inputId="place", label="Place"),
  actionButton(inputId="delete", label="Delete"),
  tableOutput(outputId="table")
)

server <- function(input, output, session){
  r <- reactiveValues(
    i=0,
    id=NULL,
    lat=NULL,
    lng=NULL)

  ### Map display
  output$map <- renderLeaflet(expr={
    leaflet() %>% addTiles() %>% setView(lng=135, lat=35, zoom=9)
  })

  ### Place a marker temporarily
  observeEvent(
    eventExpr=input$map_click,
    handlerExpr={
      leafletProxy(mapId="map", session=session) %>%
        clearShapes() %>%
        addMapkeyMarkers(lng=input$map_click$lng, lat=input$map_click$lat, layerId = "marker")
    }
  )

  ### Fix a marker and write memorandum
  observeEvent(
    eventExpr=input$place,
    handlerExpr={
      r$i <- r$i + 1 # marker id
      r$lat <- append(r$lat, input$map_click$lat)
      r$lng <- append(r$lng, input$map_click$lng)
      r$table <- data.frame(r$lat, r$lng)
      r$table$index <- c(1:r$i) # rownames(r$table)

      output$table <- renderTable(expr={
        r$table
      })

      showModal(
        ui = modalDialog(
          textInput(inputId="content", label="Message:"),
          footer = actionButton(inputId = "set_content", label = "OK"),
          easyClose = TRUE
        )
      )
    }
  )

  ### Remove modal when clicking "OK" button
  observeEvent(
    eventExpr=input$set_content,
    handlerExpr={
      leafletProxy(mapId="map", session=session) %>%
        addMarkers(lng=r$lng, lat=r$lat, layerId=sprintf("%d", as.integer(r$i)), popup=r$content())
      removeModal()
    }
  )

  ### Getting marker id which is selected
  observeEvent(
    eventExpr=input$map_marker_click,
    handlerExpr={
      r$id <- input$map_marker_click$id
      # p <- input$map_marker_click
      # print(p)
    }
  )

  ### Delete a marker when clicking "Delete" button
  observeEvent(
    eventExpr=input$delete,
    handlerExpr={
      leafletProxy(mapId="map", session=session) %>% 
        removeMarker(layerId = r$id)
      r$id <- NULL
      r$lat <- NULL
      r$lng <- NULL
    }
  )


}

shinyApp(ui, server)

上記を実行した結果が以下の GIF のようになる。簡易的に作成したため修正点は多々あるが、ここまでとする。