我正在用 R 编写一张传单地图并将其与闪亮的集成。我有三个问题要问,代码将在底部突出显示问题:
在这张地图上,我有随机标记,每个标记代表一个水生环境。我还有一个下拉列表允许您选择您想要的特定环境,它只会选择与环境相对应的那些标记。我创建了absolutePanel,它允许您执行此操作,但无法使用反应函数让脚本为标记选择。
不是一个重要的因素,但会很有用。我已经突出显示了包含标记的国家/地区,但是当您移动滑块以选择要查看的年份和相应的标记时,“空白”国家仍然存在。由于标记是根据年份删除的,我希望不再包含标记的国家/地区被突出显示。而且它似乎很慢。
只是为了兴趣,但是有没有像“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)