R Shiny Leaflet map - всплывающее окно с одной точкой мешает рисованию или редактированию многоугольника - PullRequest
Новая
       12

R Shiny Leaflet map - всплывающее окно с одной точкой мешает рисованию или редактированию многоугольника

0 голосов
/ 25 марта 2020

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

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

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

Есть ли способ определить, включены ли параметры «рисовать» или «редактировать» в настоящее время, поэтому я могу Не запускается ли код щелчка мышью при выполнении этих условий?

У меня очень мало опыта работы с Javascript и HTML, поэтому я надеюсь найти решение, которое не слишком техническое ...

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

library(shiny)
library(leaflet)
library(leaflet.extras)
library(sp)

ui <- fluidPage(

    leafletOutput("map", height=600),

    textOutput("stat")

)

server <- function(input, output) {

    # To collect newly drawn or edited polygons
    state <- reactiveValues()

    # Example dataset to plot on map
    state$df <- dplyr::storms

    output$map <- renderLeaflet(

        # Create base map
        leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
            addProviderTiles("Esri.WorldTopoMap") %>%
            addCircles(data = state$df,
                       ~long, ~lat,
                       radius = 100,
                       fillOpacity = 0.7,
                       stroke = FALSE) %>%
            addDrawToolbar(polylineOptions = FALSE,
                           circleOptions = FALSE,
                           markerOptions = FALSE,
                           circleMarkerOptions = FALSE,
                           rectangleOptions = FALSE,
                           singleFeature = TRUE,
                           editOptions = editToolbarOptions())

    )

    # Use leafletProxy to update base map
    map <- leafletProxy("map")

    # Collect drawn/edited polygons
    observeEvent(input$map_draw_new_feature, {
        state$newpoly <- input$map_draw_new_feature
        state$editedpoly <- NULL
    })
    observeEvent(input$map_draw_edited_features, {
        state$newpoly <- NULL
        state$editedpoly <- input$map_draw_edited_features
    })
    observeEvent(input$map_draw_deleted_features, {
        state$newpoly <- NULL
        state$editedpoly <- NULL
    })

    # Compute stats based on drawn/edited polygons
    polygon_stats <- reactive({

        # Check for new coordinates
        coords <- try(unlist(state$newpoly$geometry$coordinates))

        # Check for edited coordinates
        if (is.null(coords)) {
            coords <- try(unlist(state$editedpoly$features[[1]]$geometry$coordinates))
        }

        # If polygon exists, use its coordinates to compute the median of a variable
        result <- NA
        if (!is.null(coords)) {
            # Extract longitude/latitude values from the list of coordinates
            Longitude <- coords[seq(1,length(coords), 2)]
            Latitude <- coords[seq(2,length(coords), 2)]
            # Use the sp package to extract all data points within the polygon for
            # a selected variable (pressure), and compute the median
            mask <- as.logical(point.in.polygon(state$df$long, state$df$lat, Longitude, Latitude))
            variable <- state$df$pressure[mask]
            result <- median(variable, na.rm=TRUE)
        }

        return(result)

    })

    output$stat <- renderText(
        paste0("Median value of selected region: ", polygon_stats())
    )

    # Create a popup if a point on the map is clicked
    observeEvent(input$map_click, {

        # Get the coordinates of a single clicked point
        coords <- input$map_click

        # Add a popup to the proxy map located at the point click coordinates
        map %>% addPopups(lng = coords$lng,
                          lat = coords$lat,
                          popup = "test")

    })

}

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