I posted a similar question, but didn't make my example minimal enough, so I tried to pare it down some. So here's the problem:
I am working on a COVID19 project to visualize the spread of the virus across the world. I have a choropleth map of the world that uses a date slider to update the map with the number of cases and deaths by country. I have a button that updates the map by adjusting the metrics by population.
I have created two sets of color/bin/palette controls for the map based on whether or not the data is adjusted for population. When the data is not adjusted, the colors on the map seem to correlate appropriately to the bin color categories, but when I adjust for population, the colors do not seem to update with the new bin color categories. They seem to correlate with the first bin color categories.
For example, when I want to look at cumulative cases and cumulative deaths adjusted for population, the numbers are much smaller, but the new color palette is still associated with the original color palette (for non-adjusted metrics), so it looks like there's no data/extremely low counts.
//Ignore the missing countries in the map//
I figure the issue lies somewhere with the pal3 and pal4 arguments not being recognized. Can someone explain why these arguments are being ignored? Or is it another issue that I'm missing?
Here is my code:
#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)
As you can see in the 2nd picture, the color for Brazil should be a dark orange.
