0

我正在用 R 编写一张传单地图并将其与闪亮的集成。我有三个问题要问,代码将在底部突出显示问题:

  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)
4

0 回答 0