Closed j23414 closed 5 years ago
Is it possible to incorporate a USA heatmap for the segments and range? Something like the following figure and code?
library(magrittr) library(readxl) library(zoo) library(lubridate) library(ggplot2) library(reshape2) # ===== State plots # state stuff starts here... # Make sure all states are there, rename states to regions for plotting maps prepStateNames <- function(state_str){ state_str = as.character(state_str) %>% { . = case_when(.=="AK"~"alaska", .=="AL"~"alabama", .=="AR"~"arkansas", .=="AZ"~"arizona", .=="CA"~"california", .=="CO"~"colorado", .=="CT"~"connecticut", .=="DC"~"district of columbia", .=="DE"~"delaware", .=="FL"~"florida", .=="GA"~"georgia", .=="HI"~"hawaii", .=="IA"~"iowa", .=="ID"~"idaho", .=="IL"~"illinois", .=="IN"~"indiana", .=="KS"~"kansas", .=="KY"~"kentucky", .=="LA"~"louisiana", .=="MA"~"massachusetts", .=="MD"~"maryland", .=="ME"~"maine", .=="MI"~"michigan", .=="MN"~"minnesota", .=="MO"~"missouri", .=="MS"~"mississippi", .=="MT"~"montana", .=="NC"~"north carolina", .=="ND"~"north dakota", .=="NE"~"nebraska", .=="NH"~"new hampshire", .=="NJ"~"new jersey", .=="NM"~"new mexico", .=="NV"~"nevada", .=="NY"~"new york", .=="OH"~"ohio", .=="OK"~"oklahoma", .=="OR"~"oregon", .=="PA"~"pennsylvania", .=="RI"~"rhode island", .=="SC"~"south carolina", .=="SD"~"south dakota", .=="TN"~"tennessee", .=="TX"~"texas", .=="UT"~"utah", .=="VA"~"virginia", .=="VT"~"vermont", .=="WA"~"washington", .=="WI"~"wisconsin", .=="WV"~"west virginia", .=="WY"~"wyoming") } %>% factor(., levels=c("alaska","alabama","arkansas","arizona","california","colorado","connecticut", "district of columbia","delaware","florida","georgia","hawaii","iowa","idaho", "illinois","indiana","kansas","kentucky","louisiana","massachusetts","maryland", "maine","michigan","minnesota","missouri","mississippi","montana","north carolina", "north dakota","nebraska","new hampshire","new jersey","new mexico","nevada", "new york","ohio","oklahoma","oregon","pennsylvania","rhode island","south carolina", "south dakota","tennessee","texas","utah","virginia","vermont","washington","wisconsin", "west virginia","wyoming")) return(state_str) } facetMaps <- function(df, col1){ # get states long and lat values states <- map_data("state") # add info cdata <- df %>% subset(.,State!="NoState" ) %>% subset(.,!is.na(.[[col1]])) %>% mutate(region=State %>% prepStateNames ) %>% dcast(.,region~.[[col1]], fun.aggregate = length, value.var=col1,drop=FALSE) %>% melt(.,id="region") data_geo <- cdata %>% merge(states,., by="region",all.x=T) %>% arrange(order) # Labels snames <- data.frame(region=tolower(state.name), long=state.center$x, lat=state.center$y) snames <- merge(snames, cdata, by="region") # do not label zeros snames$value[snames$value=="0"]="" #plot, viridae color palette? p <- ggplot() + geom_polygon(data=data_geo,aes(x=long,y=lat,group=group,fill=log(value)),color="lightgrey") + scale_fill_gradient2(low="white", mid = "#43a2ca",high="#0868ac", midpoint = 3, guide="colorbar")+ geom_text(data=snames, aes(long, lat, label=value))+ theme_void()+theme(legend.position = "none",text=element_text(size=28))+ facet_wrap(~variable)+ coord_fixed(1.3) } # == subtype map (p<-my.data %>% { .$Subtype[grep(",",.$Subtype)]="Mixed" .$Subtype[grep("mixed",.$Subtype)]="Mixed" . } %>% facetMaps(., "Subtype")) # H1 map p<-my.data %>% { .$H1 = gsub(",.*","",.$H1) . } %>% facetMaps(., "H1") p
Done, thanks for the code, worked great!
Is it possible to incorporate a USA heatmap for the segments and range? Something like the following figure and code?