Как щелкнуть карту листовки, создать маркер, а затем удалить этот маркер, когда я нажимаю в другом месте R - PullRequest
0 голосов
/ 15 октября 2018

Я создал блестящее приложение, которое отображает листовую карту точек во фрейме данных.

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

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

Я написал работающее приложение Shiny, но не могу заставить его работать.

  1. Я попытался использовать clearMarkers, но при этом удаляются ВСЕ маркера, как тот, который я создал, так и тот, что находится в базовом кадре данных.

  2. Я попытался указать идентификатор нажатой точки, чтобы clearMarkers могла просто удалить эту точку, но я понятия не имею, кто может узнать идентификатор нажатой точки.

Как мне заставить это работать?

Вот мой игрушечный код:

library(shiny)
library(sp)
library(shinydashboard)
library(leaflet)

#### Make a spatial data frame 
lats<-c(37.38,39)
lons<-c(-94,-95,-96)
df<-data.frame(cbind(lons,lats))
coordinates(df)<-~lons+lats

#### Define UI for application that draws a histogram
ui <- dashboardPage(

    dashboardHeader(
    ),

    # Sidebar layout with input and output definitions 
    dashboardSidebar(
    ),

    # Main panel for displaying outputs 
    dashboardBody(
                     h2("My Map", align="center"),
                     h5("Click anywhere to draw a circle", align="center"),
                     leafletOutput("mymap", width="100%", height="500px")
        ),
    )



#### Define server logic required to draw a histogram
server <- function(input, output) {

    output$mymap <- renderLeaflet({
                 m = leaflet(df,width="100%",height="100%") %>% 
                 addTiles()    %>%
                 addCircleMarkers()
    })

    observeEvent(input$mymap_click, {

        click <- input$mymap_click
        text<-paste("Latitude ", round(click$lat,2), "Longtitude ", round(click$lng,2))

        proxy <- leafletProxy("mymap")

        ## This displays the pin drop circle
        proxy %>% 
            #clearPopups() %>%
            #clearMarkers(layerId=input$mymap_click$id) %>%
            #addPopups(click$lng, click$lat) %>%
            addCircles(click$lng, click$lat, radius=100, color="red")

    })


}

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

1 Ответ

0 голосов
/ 15 октября 2018

Вы можете использовать group аргумент addCircles вместе с clearGroup для этого -

library(shiny)
library(sp)
library(shinydashboard)
library(leaflet)

#### Make a spatial data frame 
lats<-c(37.38,39)
lons<-c(-94,-95,-96)
df<-data.frame(cbind(lons,lats))
coordinates(df)<-~lons+lats

#### Define UI for application that draws a histogram
ui <- dashboardPage(

    dashboardHeader(
    ),

    # Sidebar layout with input and output definitions 
    dashboardSidebar(
    ),

    # Main panel for displaying outputs 
    dashboardBody(
                     h2("My Map", align="center"),
                     h5("Click anywhere to draw a circle", align="center"),
                     leafletOutput("mymap", width="100%", height="500px")
        ),
    )



#### Define server logic required to draw a histogram
server <- function(input, output) {

    output$mymap <- renderLeaflet({
                 m = leaflet(df,width="100%",height="100%") %>% 
                 addTiles()    %>%
                 addCircleMarkers()
    })


    observeEvent(input$mymap_click, {

        click <- input$mymap_click
        text<-paste("Latitude ", round(click$lat,2), "Longtitude ", round(click$lng,2))

        proxy <- leafletProxy("mymap")

        ## This displays the pin drop circle
        proxy %>% 
            clearGroup("new_point") %>%
            #clearMarkers(layerId=input$mymap_click$id) %>%
            #addPopups(click$lng, click$lat) %>%
            addCircles(click$lng, click$lat, radius=100, color="red", group = "new_point")

    })


}

# Run the application 
shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...