ggplot two gradient fills on one plot

Question

I've been producing animated maps showing the progression of COVID case data. In the interest of producing a minimal example I have skinnied the code down to the below, which only produces one frame. In practice I also read a number of csv files. I've tried to eliminate that in this example, but there is still one with county population data. I have posted it at https://pastebin.com/jCD9tP0X

library(urbnmapr) # For map
library(ggplot2)  # For map
library(dplyr)    # For summarizing
library(tidyr)    # For reshaping
library(stringr)  # For padding leading zeros
library(ggrepel)
library(ggmap)
library(usmap)
library(gganimate)
library(magrittr)
library(gifski)
library(scales)


#first run setup tasks
#these can be commented out once the data frames are in place

###################begin first run only################################

#define census regions
NE_region <- c("ME","NH","VT","MA", "CT", "RI", "NY", "PA", "NJ")

ne_region_bases <-c("Hanscom AFB", "Rome, NY")

# Get COVID cases, available from:
url <- "https://static.usafacts.org/public/data/covid-19/covid_confirmed_usafacts.csv"
COV <- read.csv(url, stringsAsFactors = FALSE)

#sometimes there are encoding issues with the first column name
names(COV)[1] <- "countyFIPS"

Covid <- pivot_longer(COV, cols=starts_with("X"),
                      values_to="cases",
                      names_to=c("X","date_infected"),
                      names_sep="X") %>%
  mutate(infected = as.Date(date_infected, format="%m.%d.%Y"),
         countyFIPS = str_pad(as.character(countyFIPS), 5, pad="0"))

# Obtain map data for counties (to link with covid data) and states (for showing borders)
states_sf <- get_urbn_map(map = "states", sf = TRUE)
counties_sf <- get_urbn_map(map = "counties", sf = TRUE)

# Merge county map with total cases of cov
#use this line to produce animated maps
#pop_counties_cov <- inner_join(counties_sf, Covid, by=c("county_fips"="countyFIPS"))

#use this one for a single map of the latest data
pop_counties_cov <- inner_join(counties_sf, group_by(Covid, countyFIPS) %>%
                             summarise(cases=sum(cases)), by=c("county_fips"="countyFIPS"))

#read the county population data
#csv at https://pastebin.com/jCD9tP0X
counties_pop <- read.csv("countyPopulations.csv", header=TRUE, stringsAsFactors = FALSE)

#pad the single digit state FIPS states
counties_pop <- counties_pop %>% mutate(CountyFIPS=str_pad(as.character(CountyFIPS),5,pad="0"))

#merge the population and covid data by FIPS
pop_counties_cov$population <- counties_pop$Population[match(pop_counties_cov$county_fips,counties_pop$CountyFIPS)]

#calculate the infection rate
pop_counties_cov <- pop_counties_cov %>% mutate(infRate = (cases/population)*100)

#counties with 0 infections don't appear in the usafacts data, so didn't get a population
#set them to 0
pop_counties_cov$population[is.na(pop_counties_cov$population)] <- 0
pop_counties_cov$infRate[is.na(pop_counties_cov$infRate)] <- 0

plotDate="April14"
basepath = "your/output file/path/here/"
naColor = "white"
lowColor = "green"
midColor = "maroon"
highColor = "red"
baseFill = "dodgerblue4"
baseColor = "firebrick"
baseShape = 23
###################end first run only################################


###################Northeast Map################################
#filter out states
ne_pop_counties_cov <- pop_counties_cov %>% filter(state_abbv %in% NE_region)
ne_states_sf <- states_sf %>% filter(state_abbv %in% NE_region)
ne_counties_sf <- counties_sf %>% filter(state_abbv %in% NE_region)

#filter out bases
neBases <- structure(list(Base = c("Hanscom AFB", "Rome, NY"), longitude = c(-71.2743123, 
                                                                             -75.4557303), 
                          latitude = c(42.4579955, 43.2128473), 
                          personnel = c(2906L,822L), 
                          longitude.1 = c(2296805.44531269, 1951897.82199569), 
                          latitude.1 = c(128586.352781279, 99159.9145180969)), 
                          row.names = c(NA, -2L), class = "data.frame")

p <- ne_pop_counties_cov %>%
  ggplot() +
  geom_sf(mapping = aes(fill = infRate, geometry=geometry), color = NA) +
  geom_sf(data = ne_states_sf, fill = NA, color = "black", size = 0.25) +
  coord_sf(datum = NA) +   
  scale_fill_gradient(name = "% Pop \nInfected", trans = "log",low=lowColor, high=highColor,
                      breaks=c(0, max(ne_pop_counties_cov$infRate)),
                      na.value = naColor) +
  geom_point(data=neBases, 
             aes(x=longitude.1, y=latitude.1,size=personnel), 
             shape = baseShape,
             color = baseColor,
             fill = baseFill) +
  theme_bw() + 
  labs(size='AFMC \nMil + Civ') +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank())

print(p)

###################End Northeast Map################################

If you run this you should get a single frame...when I do the whole animation, here is the final frame

The diamonds represent the locations of air force bases we're interested in within the region, and they are sized by how many personnel are there.

What I have been asked to do is to make the diamonds the same size, but "color code" the fill based on the number of personnel. I don't think this is a good idea, but I'm not the boss.

I'm not sure how to have two gradient fills on a single plot?

Answer 1

If you want to place a second filling gradient, you can have the use of new_scale_fill function from ggnewscale package:

library(ggnewscale)

p <- ne_pop_counties_cov %>%
  ggplot() +
  geom_sf(mapping = aes(fill = infRate, geometry=geometry), color = NA) +
  geom_sf(data = ne_states_sf, fill = NA, color = "black", size = 0.25) +
  coord_sf(datum = NA) +   
  scale_fill_gradient(name = "% Pop \nInfected", trans = "log",low=lowColor, high=highColor,
                      breaks=c(0, max(ne_pop_counties_cov$infRate)),
                      na.value = naColor) +
  new_scale_fill()+
  geom_point(data=neBases, 
             aes(x=longitude.1, y=latitude.1,fill=personnel), 
             shape = baseShape,
             color = "black",
             #fill = baseFill,
             size = 5) +
  scale_fill_gradient(name = "AFMC \nMil + Civ",
                      low = "blue", high = "magenta",
                      breaks = c(1,max(neBases$personnel)))+
  theme_bw() + 
  theme(legend.position="bottom",
        panel.border = element_blank(),
        axis.title.x=element_blank(), 
        axis.title.y=element_blank())

print(p)

Does it answer your question ?