Question

我正在R中编写Leaflet地图并将其与闪亮的整合。我有三个问题要问，代码将在底部，突出显示问题：

在这张地图上，我有随机标记，每个标记代表一个水生环境。我还有一个下拉列表，允许您选择所需的特定环境，只选择与环境对应的标记。我创建了absolutePanel，它允许你这样做，但是无法使用反应函数让脚本选择标记。
不是一个重要的因素，但会很有用。我已经突出显示了包含标记的国家/地区，但是当您移动滑块以选择年份和要查看的相应标记时，＆＃34;清空＆＃34;国家仍然存在。随着基于年份移除标记，我希望不再包含标记的国家/地区。它似乎也很慢。
只是为了感兴趣，但是有一个地图像＆＃34; OpenStreetMap.Mapink＆＃34;那完全是英文的？

下面是链接的数据文件，以及地图的脚本：

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)

根据R中的特征选择标记 - Leaflet - Shiny

0 个答案: