问题描述
我是tmap的新手，甚至对Shiny还是新手，所以我希望这个问题对我而言不是一个错误。我在将tm_remove（）与zindex一起使用时遇到问题，因为应该取消选择的点数据仍然保留在地图上。在RShiny之外使用tmap_mode（'view'）或tmap_mode（'plot'）时，这不是问题。
该地图包含新西兰的河流净度值，大小和颜色均代表这些值。在下面的示例中，选择了坎特伯雷地区（南岛，东海岸和小半岛）。所有其他气泡都应该消失了：
When selecting just Canterbury region
在RShiny外部进行测试的代码如下：
library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(tmap)
library(jsonlite)
library(geojsonsf)
library(httr)
library(sf)
library(RColorBrewer)
library('shinydashboard')
library("DT")
# load river quality point data
# 1) water clarity
water_clarity <- st_read("water-clarity-19892013.shp")
# 2) ammonical nitrogen
am_nitrogen <- st_read("ammoniacal-nitrogen-trends-19892013.shp")
# 3) nitrate nitrogen
nitrate_nitrogen <- st_read("nitratenitrogen-trends-19892013.shp")
# merge all together into one data set (subset by npID)
full_rivers <- rbind(water_clarity,am_nitrogen)
full_rivers <- rbind(full_rivers,nitrate_nitrogen)
# get and subset region names of NZ
# get the unique names of all regions
region_names <- unique(nz_regions$REGC2020_V1_00_NAME)
# convert to char and exclude 'outside region'
region_names <- as.character(region_names[1:16])
# lookup table of region names,for referencing in the server
# when a region is selected
region_lookup <- c("Manawatū-Whanganui Region" = "HRC","Greater Wellington Region" = "GWRC","Nelson Region" = "NRC","Taranaki Region" = "TRC","Marlborough Region" = "MDC","Hawke's Bay Region" = "HBRC","Auckland Region" = "AC","Otago Region" = "ORC","Canterbury Region" = "ECAN","Tasman Region" = "TDC","Southland Region" = "ES","Gisborne Region" = "GDC","Bay of Plenty Region" = "BOP","west Coast Region" = "WCRC","Waikato Region" = "EW")
river_names <- full_rivers %>%
select("river") %>%
st_set_geometry(NULL)
# load regional TA shape
nz_regions <- st_read("regional-council-2020-generalised.gpkg")
nz_regions <- st_as_sf(nz_regions,coords = c("lat","long"),crs = 2193)
### Subset rivers by indicator ###
ID <- "CLAR"
mapTitle <- "Water Clarity"
popups <- c("Water Clarity" = "T_Median","Dominant Landcover Type" = "LANDCOVER","Location" = "location")
var_rivers <- full_rivers %>% filter(npID == ID)
# use lookup table to get region code for selected region
region_code <- unname(region_lookup['Canterbury Region'])
# filter the river data to the selected region
region_rivers <- var_rivers %>% dplyr::filter(srcid == region_code)
# change the bBox to encompass only that region
bBox <- nz_regions %>% filter(REGC2020_V1_00_NAME == 'Canterbury Region')
# This works as expected outside of shiny,only showing
# the point data according to the selected region.
tmap_mode('view')
tm_shape(region_rivers,bBox = st_bBox(bBox)) +
tm_bubbles(size = "T_Median",col = "T_Median",title.col = mapTitle,popup.vars = popups,palette = "-RdBu",style = "pretty",alpha = 0.5,id = "river",zindex = 401)
这是使用闪亮应用程序的相关代码：
# Define server logic required to draw a histogram
server <- function(input,output,session) {
cat("=== Loading primary map ===","\n")
process_rivers <- full_rivers
ID <- "CLAR"
mapTitle <- "Water Clarity"
popups <- c("Water Clarity" = "T_Median","Location" = "location")
first_map <- full_rivers %>% filter(npID == ID)
bBox <- st_bBox(nz_regions)
output$plot <- renderPlotly({
ggplotly(
ggplot(data = first_map,aes(x = T_Median)) +
geom_density(fill = "blue") +
labs(x = mapTitle)
)}
)
output$map <- renderTmap({
### Begin the map output ###
tm_shape(first_map) +
tm_bubbles(size = "T_Median",zindex = 401) +
tmap_options(basemaps = c(Canvas = "Esri.OceanBasemap"))
})
output$riverDT <- DT::renderDataTable({
DT::datatable(first_map)
})
### Loading new layer of selected data when loadbutton is clicked ###
observeEvent(input$loadbutton,{ # shiny keeping an eye on the load button
process_rivers <- full_rivers
cat("=== Changing variables ===","\n")
### Subset rivers by indicator ###
if (input$indicator == "Water Clarity") {
ID <- "CLAR"
mapTitle <- "Water Clarity"
popups <- c("Water Clarity" = "T_Median","Location" = "location")
var_rivers <- process_rivers %>% filter(npID == ID)
} else if (input$indicator == "Ammonium Nitrate") {
ID <- "NH4N"
mapTitle <- "Ammonium Nitrate"
popups <- c("Ammonium Nitrate" = "T_Median","Location" = "location")
var_rivers <- process_rivers %>% filter(npID == ID)
} else if (input$indicator == "Nitrate nitrogen") {
ID <- "NO3N"
mapTitle <- "Nitrate nitrogen"
popups <- c("Nitrate nitrogen" = "T_Median","Location" = "location")
var_rivers <- process_rivers %>% filter(npID == ID)
} else {
cat("=== This message shouldn't show ===","\n")
}
### Subset rivers by "srcid" variable ###
cat("=== Changing selected rivers ===","\n")
if (input$region == "All regions") {
### displaying all data (nothing needed to be done) ###
cat("=== displaying all rivers ===","\n")
region_rivers <- var_rivers
bBox <- var_rivers
} else {
### Taking the selected region and displaying only that data ###
# use lookup table to get region code for selected region
cat("=== A region was selected ===","\n")
region_code <- unname(region_lookup[input$region])
cat("=== This is the selected region code: ",region_code," === \n")
# filter the river data to the selected region
region_rivers <- var_rivers %>% dplyr::filter(srcid == region_code)
# change the bBox to encompass only that region
bBox <- nz_regions %>% filter(REGC2020_V1_00_NAME == input$region)
# display in shell that change has taken place
cat("=== This is the data after being filtered for the selected rivers: === \n")
print(region_rivers$srcid)
}
### Load a new map with the updated data ###
cat("=== Loading new map ===","\n")
tmapProxy("map",session,{
# Remove prevIoUs layer and add new layer
cat("=== Layer Removed ===","\n")
tm_remove_layer(401) +
tm_shape(region_rivers,bBox = st_bBox(bBox)) +
tm_bubbles(size = "T_Median",zindex = 401) +
tmap_options(basemaps = c(Canvas = "Esri.OceanBasemap"))
})
此外，正在使用的tmap版本是3.2。
任何可以提供的帮助将不胜感激-我不知为什么会发生这种情况！
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）