反应式传单地图无法识别第二个调色板
问题描述 投票：0回答：1
我正在开展一个新冠肺炎 (COVID19) 项目，以可视化该病毒在世界范围内的传播情况。我有一张世界分区统计图，它使用日期滑块来更新地图，其中包含按国家/地区划分的病例数和死亡人数。我有一个按钮，可以通过按人口调整指标来更新地图。
我根据数据是否针对人口进行调整，为地图创建了两组颜色/容器/调色板控件。当未调整数据时，地图上的颜色似乎与 bin 颜色类别适当相关，但是当我针对人口进行调整时，颜色似乎并未随新的 bin 颜色类别更新。它们似乎与第一个 bin 颜色类别相关。
例如，当我想查看根据人口调整后的累计病例和累计死亡人数时，数字要小得多，但新的调色板仍然与原始调色板相关联（对于未调整的指标），因此看起来像没有数据/计数极低。
//忽略地图中缺失的国家//
我认为问题出在 pal3 和 pal4 参数未被识别的地方。有人可以解释为什么这些论点被忽略吗？ 或者这是我遗漏的另一个问题？
这是我的代码：
#Read in dataset
who_data <- read.csv("https://covid19.who.int/WHO-COVID-19-global-data.csv")
pops <- read.csv("https://gist.githubusercontent.com/curran/0ac4077c7fc6390f5dd33bf5c06cb5ff/raw/605c54080c7a93a417a3cea93fd52e7550e76500/UN_Population_2019.csv")
download.file("http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip", destfile="world_shape_file.zip")
unzip("world_shape_file.zip")
world_spdf=sf::st_read(dsn = getwd(),layer = "TM_WORLD_BORDERS_SIMPL-0.3")
#-----Preprocessing Data-----#
who_data$Date <- as.Date(who_data$Date_reported)
cols=colnames(pops)
pop_data=pops[,c(cols[1],cols[length(cols)])]
colnames(pop_data)=c("Country","Population")
pop_data$Population=pop_data$Population*1000
pop_data[order(pop_data$Country),]
covid19_data=merge(x=who_data,y=pop_data,by="Country",all.x=TRUE)
#Adjust for population
covid19_data$Adjusted_NewCases=(covid19_data$New_cases/covid19_data$Population)*100000
covid19_data$Adjusted_NewDeaths=(covid19_data$New_deaths/covid19_data$Population)*100000
covid19_data$Adjusted_CumulCases=(covid19_data$Cumulative_cases/covid19_data$Population)*100000
covid19_data$Adjusted_CumulDeaths=(covid19_data$Cumulative_deaths/covid19_data$Population)*100000
#----- Load libraries -----#
library(shiny)
library(shinydashboard)
library(leaflet)
library(rgdal)
library(sp)
library(raster)
library(RColorBrewer)
library(maps)
library(shinyWidgets)
# Define UI for application
ui <- fluidPage(
dashboardPage(
dashboardHeader(title="COVID19 Analysis"),[enter image description here][1]
dashboardSidebar(
sidebarMenu(
menuItem("Spread",
tabName="map_spread",
icon=icon("virus")
))
),
dashboardBody(
tabItems(
tabItem(
tabName = "map_spread",
fluidRow(align="center",splitLayout(cellWidths = c("50%","25%","25%"),
sliderInput("date_filter", "Choose a date:",
min = min(covid19_data$Date), max = max(covid19_data$Date), value = min(covid19_data$Date)
),
prettyRadioButtons(inputId = "rb",
label = "Choose a metric:",
c("Cumulative Cases"="Cumulative Cases",
"Cumulative Deaths"="Cumulative Deaths"),
animation = "pulse"),
prettyRadioButtons(inputId = "rb1",
label = "Adjust for Population:",
c("No"="No",
"Yes"="Yes"),
animation="pulse")
)),
leafletOutput("world_map")
)))))
# Define server logic
server <- function(input, output) {
#---------- WORLD MAP ----------#
map_filter=reactive({
filter=subset(covid19_data,Date==input$date_filter)
return(filter)
})
merge_filter=reactive({
names(world_spdf)[names(world_spdf) == "NAME"] <- "Country"
map_data=merge(x=world_spdf,y=map_filter(),by="Country",all.x=TRUE)
})
#----Map: Choropleth Map----#
output$world_map=renderLeaflet({
bins=c(0,500,1000,5000,10000,100000,500000,1000000,5000000,Inf)
pal=colorBin(palette = "YlOrBr",domain = merge_filter()$Cumulative_cases,na.color = "transparent",bins=bins)
customLabel = paste(strong("Country: "),merge_filter()$Country,"<br/>",
strong("Cumulative Cases: "),formatC(merge_filter()$Cumulative_cases,format="d",
big.mark=","), serp="") %>%
lapply(htmltools::HTML)
pal2=colorBin(palette = "YlOrBr",domain = merge_filter()$Cumulative_deaths,na.color = "transparent",bins=bins)
customLabel2 = paste(strong("Country: "),merge_filter()$Country,"<br/>",
strong("Cumulative Deaths: "),formatC(merge_filter()$Cumulative_deaths,format="d",big.mark=","), serp="") %>%
lapply(htmltools::HTML)
bins2=c(0,25,50,100,250,500,1000,2500,5000,Inf)
pal3=colorBin(palette = "YlOrBr",domain = merge_filter()$Adjusted_CumulCases,na.color = "transparent",bins=bins2)
customLabel3 = paste(strong("Country: "),merge_filter()$Country,"<br/>",
strong("Cumulative Cases per 100,000 people: "),formatC(merge_filter()$Adjusted_CumulCases,format="d",big.mark=","), serp="") %>%
lapply(htmltools::HTML)
pal4=colorBin(palette = "YlOrBr",domain = merge_filter()$Adjusted_CumulDeaths,na.color = "transparent",bins=bins2)
customLabel4 = paste(strong("Country: "),merge_filter()$Country,"<br/>",
strong("Cumulative Deaths per 100,000 people: "),formatC(merge_filter()$Adjusted_CumulDeaths,format="d",big.mark=","), serp="") %>%
lapply(htmltools::HTML)
switch(input$rb1,
"No"=
switch(input$rb,
"Cumulative Cases"=
leaflet(merge_filter()) %>%
addProviderTiles(providers$OpenStreetMap,options=tileOptions(minZoom = 1.5,maxZoom = 8)) %>%
addPolygons(fillColor = ~pal(Cumulative_cases),
fillOpacity = 0.9,stroke = TRUE,color = "white",
highlight=highlightOptions(weight=5,fillOpacity = 0.3),
label=customLabel,weight=0.3,smoothFactor = 0.2) %>%
addLegend(pal=pal,values = ~Cumulative_cases,position = "bottomright",title = "Cumulative Cases"
),
"Cumulative Deaths"=
leaflet(merge_filter()) %>%
addProviderTiles(providers$OpenStreetMap,options=tileOptions(minZoom = 1.5,maxZoom = 8)) %>%
addPolygons(fillColor = ~pal(Cumulative_deaths),
fillOpacity = 0.9,stroke = TRUE,color = "white",
highlight=highlightOptions(weight=5,fillOpacity = 0.3),
label=customLabel2,weight=0.3,smoothFactor = 0.2) %>%
addLegend(pal=pal2,values = ~Cumulative_deaths,position = "bottomright",title = "Cumulative Deaths"
)),
"Yes"=
switch(input$rb,
"Cumulative Cases"=
leaflet(merge_filter()) %>%
addProviderTiles(providers$OpenStreetMap,options=tileOptions(minZoom = 1.5,maxZoom = 8)) %>%
addPolygons(fillColor = ~pal(Adjusted_CumulCases),
fillOpacity = 0.9,stroke = TRUE,color = "white",
highlight=highlightOptions(weight=5,fillOpacity = 0.3),
label=customLabel3,weight=0.3,smoothFactor = 0.2) %>%
addLegend(pal=pal3,values = ~Adjusted_CumulCases,position = "bottomright",title = "Cumulative Cases"
),
"Cumulative Deaths"=
leaflet(merge_filter()) %>%
addProviderTiles(providers$OpenStreetMap,options=tileOptions(minZoom = 1.5,maxZoom = 8)) %>%
addPolygons(fillColor = ~pal(Adjusted_CumulDeaths),
fillOpacity = 0.9,stroke = TRUE,color = "white",
highlight=highlightOptions(weight=5,fillOpacity = 0.3),
label=customLabel4,weight=0.3,smoothFactor = 0.2) %>%
addLegend(pal=pal4,values = ~Adjusted_CumulDeaths,position = "bottomright",title = "Cumulative Deaths"
)))
})
}
# Run the application
shinyApp(ui = ui, server = server)
正如您在第二张图片中看到的，巴西的颜色应该是深橙色。
1个回答
1
投票
投票
您必须提供使用
colorBinaddPolygons尝试
leaflet(merge_filter()) %>%
addProviderTiles(providers$OpenStreetMap,options=tileOptions(minZoom = 1.5,maxZoom = 8)) %>%
addPolygons(fillColor = ~pal2(Cumulative_deaths),
fillOpacity = 0.9,stroke = TRUE,color = "white",
highlight=highlightOptions(weight=5,fillOpacity = 0.3),
label=customLabel2,weight=0.3,smoothFactor = 0.2) %>%
addLegend(pal=pal2,values = ~Cumulative_deaths,position = "bottomright",title = "Cumulative Deaths"
))
等（
pal3pal4fillColoraddLegend最新问题
- 使用HTML页面中的按钮打开不同的Iframe
- 不同加数问题 - 贪心算法 (Python)
- PDDL 检查条件
- 使用Canvas API时有哪些典型的设计模式？
- Raydium 交换跟踪
- 如何删除绘图和窗口之间的填充
- 如何使用 JSON 对象循环遍历数组，以查找满足条件的项目
- MongoDB 未作为服务运行[已关闭]
- 我可以通过在messagebox.showinfo中单击“确定”来调用函数吗？
- nginx 入口控制器无法与 websockets 连接
- Flutter 全局材质本地化和初始化日期格式不能一起工作
- 如何下载 Rust API 文档？
- “找不到 NSObject 的接口声明”？
- Hibernate内存泄漏-BoundedConcurrentHashMap
- 电子应用程序菜单工作示例
- Mac 应用商店中有骰子游戏吗？
- MongoDB 未使用 CMD 在我的 PC 上本地运行
- Wiremock - 从 URL 中获取字符串，修改它并将其作为正文的一部分返回
- 发现了意外的标记“END-OF-STATEMENT”
- 当我停止按下 :active css 时动画就会剪切
© www.soinside.com 2019 - 2024. All rights reserved.