scale_fill_gradientn() 成功填充 map 但未能在图例中显示所有 colors

Question

I am trying to create a map plot using ggplot2 , I want to show the counties with 0 acreages with the color blue and higher acreage with a gradient from red to green color. I am able to achieve this in the map's fill-in colors, but the legend does not show the blue for the 0.0 acreage value. I pre-divided the color and values and used scale_fill_gradientn() , however the legend is not to success. I am very unsure of what is going wrong, help is highly appreciated. Please refer to the reproducible code below.

library(tidyverse)
library(BBmisc)

d <- data.frame(fips = c(10001 , 10003 , 10005 , 21001 , 21003 , 21005 , 21007 , 21009 , 21011 , 21015 , 21017 , 21021 , 21023 , 21027 , 21029 , 21031 , 21033 , 21035 , 21037 , 21039 , 21041 , 21043 , 21045 , 21047 , 21049 , 21053 , 21055 , 21057 , 21059 , 21061 , 21065 , 21067 , 21069 , 21073 , 21075 , 21077 , 21079 , 21081 , 21083 , 21085 , 21087 , 21089 , 21091 , 21093 , 21097 , 21099 , 21101 , 21103 , 21105 , 21107 , 21109 , 21111 , 21113 , 21117 , 21121 , 21123 , 21125 , 21135 , 21137 , 21139 , 21141 , 21143 , 21145 , 21147 , 21149 , 21151 , 21155 , 21157 , 21159 , 21161 , 21163 , 21165 , 21167 , 21169 , 21171 , 21173 , 21175 , 21177 , 21179 , 21181 , 21183 , 21185 , 21187 , 21191 , 21197 , 21199 , 21201 , 21203 , 21205 , 21207 , 21209 , 21211 , 21213 , 21215 , 21217 , 21219 , 21221 , 21223 , 21225 , 21227 , 21229 , 21231 , 21233 , 21235 , 21239 , 24001 , 24003 , 24005 , 24009 , 24011 , 24013 , 24015 , 24017 , 24019 , 24021 , 24023 , 24025 , 24027 , 24029 , 24031 , 24033 , 24035 , 24037 , 24039 , 24041 , 24043 , 24045 , 24047 , 37001 , 37003 , 37005 , 37007 , 37009 , 37011 , 37013 , 37015 , 37017 , 37019 , 37021 , 37023 , 37025 , 37027 , 37029 , 37031 , 37033 , 37035 , 37037 , 37039 , 37041 , 37043 , 37045 , 37047 , 37049 , 37051 , 37053 , 37055 , 37057 , 37059 , 37061 , 37063 , 37065 , 37067 , 37069 , 37071 , 37073 , 37077 , 37079 , 37081 , 37083 , 37085 , 37087 , 37089 , 37091 , 37093 , 37095 , 37097 , 37099 , 37101 , 37103 , 37105 , 37107 , 37109 , 37111 , 37113 , 37115 , 37117 , 37119 , 37123 , 37125 , 37127 , 37129 , 37131 , 37133 , 37135 , 37137 , 37139 , 37141 , 37143 , 37145 , 37147 , 37149 , 37151 , 37153 , 37155 , 37157 , 37159 , 37161 , 37163 , 37165 , 37167 , 37169 , 37171 , 37173 , 37175 , 37177 , 37179 , 37181 , 37183 , 37185 , 37187 , 37189 , 37191 , 37193 , 37195 , 37197 , 37199 , 42009 , 42011 , 42013 , 42017 , 42025 , 42027 , 42029 , 42037 , 42041 , 42043 , 42045 , 42055 , 42057 , 42061 , 42067 , 42071 , 42075 , 42077 , 42087 , 42089 , 42091 , 42093 , 42095 , 42097 , 42099 , 42101 , 42107 , 42109 , 42119 , 42133 , 51001 , 51003 , 51005 , 51007 , 51009 , 51011 , 51015 , 51017 , 51019 , 51021 , 51023 , 51025 , 51029 , 51031 , 51033 , 51035 , 51036 , 51037 , 51041 , 51043 , 51045 , 51047 , 51049 , 51051 , 51053 , 51057 , 51059 , 51061 , 51063 , 51065 , 51067 , 51069 , 51071 , 51073 , 51075 , 51077 , 51079 , 51081 , 51083 , 51085 , 51087 , 51089 , 51091 , 51093 , 51095 , 51097 , 51099 , 51101 , 51103 , 51105 , 51107 , 51109 , 51111 , 51113 , 51115 , 51117 , 51119 , 51121 , 51125 , 51127 , 51131 , 51133 , 51135 , 51137 , 51139 , 51141 , 51143 , 51145 , 51147 , 51149 , 51153 , 51155 , 51157 , 51159 , 51161 , 51163 , 51165 , 51167 , 51169 , 51171 , 51173 , 51175 , 51177 , 51179 , 51181 , 51183 , 51185 , 51187 , 51191 , 51193 , 51195 , 51197 , 51199 , 51515 , 51520 , 51530 , 51550 , 51590 , 51595 , 51620 , 51630 , 51640 , 51650 , 51660 , 51678 , 51680 , 51683 , 51700 , 51730 , 51740 , 51750 , 51770 , 51775 , 51790 , 51800 , 51810 , 51820 , 51840),
           avg_area_acres = c(274826347 , 111810520 , 356958995 , 12225467 , 9850285 , 0 , 161517982 , 36513962 , 10627321 , 8500976 , 11011159 , 5127695 , 0 , 67608594 , 16920827 , 57891895 , 90677813 , 174713438 , 0 , 111737090 , 9175389 , 0 , 9109121 , 256162406 , 4402135 , 2327886 , 52759747 , 5463256 , 319309902 , 15382455 , 3036180 , 10039222 , 16030896 , 3197991 , 212521576 , 4046856 , 0 , 0 , 264745451 , 38377025 , 14006839 , 3338657 , 49178736 , 109703257 , 8824662 , 11173159 , 320523707 , 16273015 , 186374168 , 154012358 , 0 , 6070285 , 3642904 , 0 , 0 , 78336064 , 0 , 13759312 , 17568827 , 61018542 , 236490220 , 27424132 , 96956005 , 0 , 206767773 , 0 , 31173369 , 63229941 , 0 , 15128662 , 61045205 , 0 , 4586437 , 4128988 , 2226557 , 3643585 , 0 , 65578941 , 59265028 , 2428114 , 126995190 , 13925398 , 0 , 4209674 , 8296056 , 28642983 , 0 , 3710771 , 3339207 , 14816021 , 4856228 , 76817157 , 155771635 , 20563941 , 28336357 , 178198387 , 72704615 , 12853799 , 238138534 , 107598640 , 13661127 , 22993123 , 155120806 , 0 , 6206647 , 0 , 18314776 , 43712808 , 11738189 , 196002816 , 82823831 , 73270421 , 46040458 , 189830024 , 112293371 , 0 , 43395064 , 13963462 , 160870422 , 58778462 , 16594705 , 238589996 , 64963441 , 69212640 , 169997441 , 36023074 , 96909783 , 141439602 , 14451553 , 5627142 , 0 , 45419938 , 0 , 0 , 250418385 , 85662981 , 82094768 , 36026453 , 0 , 3060241 , 28376260 , 3218257 , 121200604 , 100712697 , 8906102 , 26029460 , 10120473 , 910542.7 , 29137366 , 890308.4 , 41413487 , 209038639 , 90114900 , 79827082 , 63393639 , 4586437 , 31454134 , 26271517 , 195279264 , 3895807 , 137398970 , 12913433 , 74078849 , 4301357 , 61049669 , 20523472 , 109219080 , 36594962 , 98945220 , 108001879 , 0 , 0 , 55219178 , 46797190 , 108652520 , 50683743 , 0 , 226125804 , 53359636 , 26675951 , 116590206 , 21697878 , 0 , 0 , 0 , 62506851 , 4857862 , 2175578 , 21050066 , 122578107 , 2495561 , 109878020 , 55702537 , 13561244 , 78614157 , 186377501 , 58814313 , 128087113 , 49549681 , 227994714 , 1315228 , 40116230 , 7958818 , 399060448 , 18095735 , 66551696 , 4047642 , 229363918 , 40847556 , 75376798 , 6880835 , 35299653 , 0 , 0 , 139744197 , 212121480 , 29671505 , 70598678 , 31292071 , 133027044 , 0 , 229286061 , 1854809 , 139092802 , 58819874 , 0 , 12750034 , 100796778 , 13602342 , 36732059 , 3508323 , 35866276 , 60717516 , 44689240 , 57780664 , 46795932 , 0 , 61018149 , 3238271 , 13053705 , 24693872 , 108004520 , 80801534 , 54323399 , 17708926 , 7993956 , 14673155 , 24285225 , 55048171 , 80636580 , 30279791 , 0 , 31268017 , 32222596 , 40641504 , 164917845 , 136580985 , 6476463 , 0 , 23802746 , 0 , 4654828 , 14087839 , 0 , 0 , 0 , 2023428 , 29851146 , 2428114 , 6315359 , 73594672 , 0 , 33032534 , 7083806 , 6962731 , 6396171 , 0 , 28336357 , 2226714 , 0 , 60721708 , 86062133 , 0 , 19673255 , 0 , 2428114 , 3374162 , 3136942 , 0 , 32708722 , 13196839 , 0 , 0 , 47560780 , 14006336 , 77238415 , 20642661 , 0 , 0 , 79749226 , 7014551 , 57969280 , 21351097 , 61288393 , 29446382 , 0 , 14370898 , 9958599 , 11536134 , 15545147 , 7589192 , 37162842 , 25584243 , 0 , 2430000 , 24936054 , 88654133 , 67926935 , 4453240 , 15464398 , 2529678 , 0 , 13035090 , 5505674 , 0 , 43800252 , 6638856 , 0 , 0 , 53434851 , 0 , 0 , 20806626 , 0 , 0 , 11820782 , 0 , 131809529 , 9067913 , 5424297 , 67685193 , 105413589 , 0 , 0 , 0 , 66551193 , 0 , 0 , 0 , 0 , 0 , 0 , 116260925 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 85624964 , 55463781 , 0 , 0))

st.id = unique(sapply(as.character(d$fip), function(x) substr(x, 1,2)))
us.map <- tigris::counties(state=st.id, cb = TRUE, year = 2016)

# Projuce counties map
county_map <- fortify(us.map, region="GEOID")

# Obtian state map, to build the state boundaries
#states_map <- map_data("state")
state_dat = tigris::states(cb = TRUE, year = 2016)
state_dat = state_dat[state_dat$STATEFP %in% c(st.id), ]

# Remove Alaska(2), Hawaii(15), Puerto Rico (72), Guam (66), Virgin Islands (78), American Samoa (60), Mariana Islands (69), Micronesia (64), Marshall Islands (68), Palau (70), Minor Islands (74)
state_dat <- state_dat[!state_dat$STATEFP %in% c("02", "15", "72", "66", "78", "60", "69", "64", "68", "70", "74"),]

# Make sure other outling islands are removed.
state_dat <- state_dat[!state_dat$STATEFP %in% c("81", "84", "86", "87", "89", "71", "76", "95", "79"),]

# Projuce state map
state_dat=fortify(state_dat, region = "STUSPS")

str_fipsselect <- 'all'
#str_fipsselect <- 'zero acres'
#str_fipsselect <- 'non-zero acres'

if(str_fipsselect == 'zero acres'){
  d <- d %>% filter(avg_area_acres == 0)
} else if(str_fipsselect == 'non-zero acres'){
  d <- d %>% filter(avg_area_acres > 0)
}

d$norm_avg_area_acres = normalize(d$avg_area_acres, method = "range")
if (min(d$avg_area_acres) <= 0){
  c_cols =  c("blue","red","green")
  v_cols = c(as.numeric(d[which(d$avg_area_acres==min(d$avg_area_acres))[1],"norm_avg_area_acres"]),
             as.numeric(d[which(d$avg_area_acres == min(d$avg_area_acres[d$avg_area_acres!=min(d$avg_area_acres)]))[1], "norm_avg_area_acres"][1]),
             as.numeric(d[which(d$avg_area_acres==max(d$avg_area_acres))[1],"norm_avg_area_acres"]))
} else {
  c_cols =  c("green", "red")
  v_cols = c(as.numeric(d[which(d$avg_area_acres==min(d$avg_area_acres))[1],"norm_avg_area_acres"]),
             as.numeric(d[which(d$avg_area_acres==max(d$avg_area_acres))[1],"norm_avg_area_acres"]))
}

ggplot() + 
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill="gray94", color=NA, show.legend = FALSE) + # this is for shade within state boundaries
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill=NA, color="gray25", size=0.1, show.legend = FALSE) + # this is for state boundaries
  geom_map(aes(fill=avg_area_acres, map_id = fips),
           data = d, map=county_map, color="palevioletred3", size=0.05, show.legend = TRUE) + # this is to show the FIPS which are under study
  scale_fill_gradientn(colors = adjustcolor(c_cols, alpha.f = 0.7),
                       values = v_cols,
                       labels =  function(x) format(x, digits = 2, scientific = TRUE),
                       name = "Average acres") +
  coord_map()

enter image description here

Answer 1

It seems that the issue is more to do with visualizing such a small block of color in the color_bar. The color_bar guide can help you tweak this.Two potential options:

Lengthen the color bar

You can lengthen the color bar to make the blue more visible. The example below is a bit ridiculous but you can play around with adjusting the color_bar height and the size of the overall plot.

ggplot() + 
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill="gray94", color=NA, show.legend = FALSE) + # this is for shade within state boundaries
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill=NA, color="gray25", size=0.1, show.legend = FALSE) + # this is for state boundaries
  geom_map(aes(fill=avg_area_acres, map_id = fips),
           data = d, map=county_map, color="palevioletred3", size=0.05, show.legend = TRUE) + # this is to show the FIPS which are under study
  scale_fill_gradientn(colors = adjustcolor(c_cols, alpha.f = 0.7),
                       values = v_cols,
                       labels =  function(x) format(x, digits = 2, scientific = TRUE),
                       name = "Average acres",
                       guide = guide_colourbar(barheight = 40)) +
  coord_map()

Adjust the bins in the colorbar

This will give more weight to the blue portion by reducing the number of nbin . It is kind of a misrepresentation of your data though, since you have a sharp break between 0 and those values above 0. Using something like color_step or a binned fill scale may be another way to look into this, depending on the distribution of your data.

ggplot() + 
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill="gray94", color=NA, show.legend = FALSE) + # this is for shade within state boundaries
  geom_polygon(data=state_dat, 
               aes(x=long, y=lat, group=group), fill=NA, color="gray25", size=0.1, show.legend = FALSE) + # this is for state boundaries
  geom_map(aes(fill=avg_area_acres, map_id = fips),
           data = d, map=county_map, color="palevioletred3", size=0.05, show.legend = TRUE) + # this is to show the FIPS which are under study
  scale_fill_gradientn(colors = adjustcolor(c_cols, alpha.f = 0.7),
                       values = v_cols,
                       labels =  function(x) format(x, digits = 2, scientific = TRUE),
                       name = "Average acres",
                       guide = guide_colourbar(barheight = 10, nbin = 15)) +
  coord_map()