Выбор маркеров на основе характеристик в R - Leaflet - Shiny - PullRequest
0 голосов
/ 11 мая 2018

Я пишу карту Leaflet в R и интегрирую ее с Shiny. У меня есть три вопроса, и код будет внизу с выделенными проблемами:

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

  2. Не важный фактор, но будет полезен. Я выделил страны, которые содержат маркеры, но когда вы перемещаете ползунок для выбора года и соответствующих маркеров, которые вы хотите просмотреть, «пустые» страны по-прежнему остаются. Поскольку маркеры удаляются в зависимости от года, я хочу, чтобы страны, в которых больше не было маркеров, были выделены. Также это кажется очень медленным.

  3. Только для интереса, но есть ли карта типа «OpenStreetMap.Mapink», которая полностью на английском языке?

Ниже приведен связанный файл данных, а также скрипт для карты:

https://drive.google.com/drive/folders/10anPY-I-B13zTQ7cjUsjQoJDcMK4NCXb?usp=sharing

library(shiny)
library(leaflet)
library(maps)
library(htmltools)
library(htmlwidgets)
library(dplyr)


###############################

map_data  <- read.csv("example1.csv", header = TRUE)

countries <- map_data %>%
  distinct(DOI, Country.s., .keep_all = TRUE)

area_data <- map_data %>%
  filter(Area.Site == "Area")

site_data <- map_data %>% 
  filter(Area.Site == "Site")

sampling_count <- count(site_data, "Country.s.")
country_count <- count(countries, "Country.s.")

bounds <- map("world", area_data$Country.s., fill = TRUE, plot = FALSE)

bounds$studies <- country_count$freq[match(gsub("\\:.*", "", bounds$names), country_count$Country.s.)]
bounds$sampling_points <- sampling_count$freq[match(gsub("\\:.*", "", bounds$names), sampling_count$Country.s.)]
bounds$year <- site_data$Publication_Year[match(gsub("\\:.*", "", bounds$names), site_data$Country.s.)]


ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", 
                width = "100%",
                height = "100%"),
  ################################
  #Question 1 
  ################################
  absolutePanel(top = 5, right = 320,
                selectInput("environment", "Sampling Source: ",
                            c("All" = "P&C",
                              "Surface Water" = "SW",
                              "Wastewater" = "WW",
                              "Sea Water" = "Sea"))),
  ################################
  #Question 1 
  ################################
  absolutePanel(bottom = 5, right = 320,
                sliderInput("year", "Publication Year(s)", min(site_data$Publication_Year), max(site_data$Publication_Year),
                            value = range(site_data$Publication_Year), step = 1, sep = "", width = 500))
)


server <- function(input, output, session) {

  marker_data <- reactive({
    site_data[site_data$Publication_Year >= input$year[1] & site_data$Publication_Year <= input$year[2],]
  })

  area_s_data <- reactive({
    area_data[area_data$Publication_Year >= input$year[1] & area_data$Publication_Year <= input$year[2],]
  })

  border_data <- reactive({
    bounds[bounds$year >= input$year[1] & bounds$year  <= input$year[2],]
  })



  output$map <- renderLeaflet({
    leaflet(map_data, options = leafletOptions(worldCopyJump = TRUE)) %>%
################################
#Question 3
################################
      addProviderTiles("OpenStreetMap.Mapnik")
################################
#Question 3
################################

  })

  observe({

    leafletProxy("map", data = marker_data()) %>%
      clearMarkers() %>%
      addAwesomeMarkers(lat = ~Latitude,
                        lng = ~Longitude,
                        label = ~paste(Aquatic_Environment_Type))

  })
  ################################
  #Question 2
  ################################
  observe({

    leafletProxy("map", data = area_s_data()) %>%
      clearShapes() %>%
      addCircles(lat = ~Latitude, 
                 lng = ~Longitude,
                 radius = ~as.numeric(Area_Radius_Meter),
                 color = "blue",
                 weight = 1,
                 highlightOptions = highlightOptions(color = "red",
                                                     weight = 2,
                                                     bringToFront = TRUE)) %>%
      addPolygons(data = bounds,
                  color = "red", 
                  weight = 2, 
                  fillOpacity = 0.1,
                  highlightOptions = highlightOptions(color = "black", 
                                                      weight = 2,
                                                      bringToFront = TRUE))
    ################################
    #Question 2
    ################################

  })

}

shinyApp(ui, server)
...