heatmap of the worlds temperature from 1850->2018

2017WorldHeatmap.r

source("read_cru_hemi.r")
#data from https://crudata.uea.ac.uk/cru/data/temperature/HadCRUT4-gl.dat
temp_dat <- read_cru_hemi("./HadCRUT4-gl2017.dat")

temp_dat_monthly <- temp_dat %>%
  select(-starts_with("cover")) %>%
  select(-starts_with("annual")) %>%
  gather(month, anomaly, -year) %>%
  mutate(month = gsub("month\\.", "", month)) %>%
  mutate(month = as.numeric(month)) 

dgr_fmt <- function(x, ...) {
        parse(text = paste(x, "", sep = ""))
}

a <- dgr_fmt(seq(1850,2017, by=15))

gg <- ggplot(temp_dat_monthly, aes(x=year, y=month, fill=anomaly))
gg <- gg + geom_tile(color="white", size=0.1)
gg <- gg + scale_fill_viridis(name="Difference from \nAverage in °C",option="inferno")
plot.title = 'Average World Temperature Since 1850'
plot.subtitle = '20th century average 13.7°C, Data HadCRUT4'
gg <- gg + ggtitle(bquote(atop(.(plot.title), atop(italic(.(plot.subtitle)), ""))))
gg <- gg + labs(x=NULL, y=NULL)

gg <- gg +
        coord_cartesian(xlim = c(1850,2017)) +
        scale_x_continuous(expand = c(0, 0),breaks = seq(1850,2017, by=15), labels = a) +
        scale_y_continuous(expand = c(0, 0), 
                           breaks = c(1,2,3,4,5,6,7,8,9,10,11,12),
                           labels = c("Jan", "Feb", "Mar", "Apr",
                                      "May", "Jun", "Jul", "Aug", "Sep",
                                      "Oct", "Nov", "Dec"))


gg <- gg + theme(plot.title=element_text(hjust=0.5))
gg <- gg+ theme(plot.title = element_text(size=22))
gg <- gg +(plot.background=element_blank())

gg <- gg+ theme(legend.position = "bottom")

ggsave("heat2017end.png", width = 10, height = 10)

read_cru_hemi <- function(filename) {
  # read in whole file as table
  tab <- read.table(filename,fill=TRUE)
  nrows <- nrow(tab)
  # create frame
  hemi <- data.frame(
    year=tab[seq(1,nrows,2),1],
    annual=tab[seq(1,nrows,2),14],
    month=array(tab[seq(1,nrows,2),2:13]),
    cover=array(tab[seq(2,nrows,2),2:13])
  )
  # mask out months with 0 coverage
  hemi$month.1 [which(hemi$cover.1 ==0)] <- NA
  hemi$month.2 [which(hemi$cover.2 ==0)] <- NA
  hemi$month.3 [which(hemi$cover.3 ==0)] <- NA
  hemi$month.4 [which(hemi$cover.4 ==0)] <- NA
  hemi$month.5 [which(hemi$cover.5 ==0)] <- NA
  hemi$month.6 [which(hemi$cover.6 ==0)] <- NA
  hemi$month.7 [which(hemi$cover.7 ==0)] <- NA
  hemi$month.8 [which(hemi$cover.8 ==0)] <- NA
  hemi$month.9 [which(hemi$cover.9 ==0)] <- NA
  hemi$month.10[which(hemi$cover.10==0)] <- NA
  hemi$month.11[which(hemi$cover.11==0)] <- NA
  hemi$month.12[which(hemi$cover.12==0)] <- NA
  #
  return(hemi)
}