NASA GISS Global Temperature Anomaly

Attribution: This document is a modification of original work by hrbrmstr (Bob Rudis). The visualizations have been updated to use the most recent NASA GISS surface temperature data and adapted with additional chart types.

Load Data

Code 
library(highcharter)

df_nasa <- read.csv(
  "https://data.giss.nasa.gov/gistemp/tabledata_v4/GLB.Ts+dSST.csv",
  header = TRUE, stringsAsFactors = FALSE, na.strings = "***", skip = 1
)

dfm <- df_nasa <- df_nasa[, c("Year", "Jan", "Feb", "Mar", "Apr", "May", "Jun",
                               "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")]

dfma <- data.frame(
  Year   = df_nasa$Year,
  lower  = apply(dfm[, 2:length(dfm)], 1, min, na.rm = TRUE),
  upper  = apply(dfm[, 2:length(dfm)], 1, max, na.rm = TRUE),
  decade = paste0(substr(df_nasa$Year, 1, 3), 0)
)

dfr     <- reshape::melt(df_nasa, id.vars = "Year", variable_name = "month")
df_nasa <- merge(dfr, dfma, sort = FALSE)
df_nasa$month <- as.character(df_nasa$month)
df_nasa$year_mon <- paste0(
  df_nasa$Year, "-",
  stringr::str_pad(
    sapply(df_nasa$month, function(x) grep(paste("(?i)", x, sep = ""), month.abb)),
    2, pad = "0"
  ),
  "-01"
)
names(df_nasa) <- tolower(names(df_nasa))
df_nasa <- df_nasa[, c("year_mon", "value", "lower", "upper", "year", "decade", "month")]
df_nasa$decade <- as.numeric(df_nasa$decade)
df <- df_nasa[order(df_nasa$year_mon), ]

caption_text <- "Temperature deviation (°C) from the 1951–1980 baseline, combining land surface and ocean measurements (1880–2026). Negative values indicate cooler periods; positive values indicate warming. Recent years (2023–2024) exceed +1.2°C, approaching the Paris Agreement 1.5°C threshold. Source: NASA GISS Surface Temperature Analysis (GISTEMP v4)."

Prepare Series

Code 
df <- dplyr::mutate(df,
  date    = lubridate::ymd(year_mon),
  tmpstmp = datetime_to_timestamp(date),
  year    = lubridate::year(date),
  month   = lubridate::month(date, label = TRUE),
  unite   = colorize(value, viridis::viridis(10, option = "B")),
  unite   = hex_to_rgba(unite, 0.65)
)

dfcolyrs <- df %>%
  dplyr::group_by(year) %>%
  dplyr::summarise(value = median(value)) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(
    color_y = colorize(value, viridis::viridis(10, option = "B")),
    color_y = hex_to_rgba(color_y, 0.65)
  ) %>%
  dplyr::select(-value)

df <- dplyr::left_join(df, dfcolyrs, by = "year")

lsseries <- df %>%
  dplyr::group_by(year) %>%
  dplyr::do(data = .$value, color = dplyr::first(.$color_y)) %>%
  dplyr::mutate(name = year) %>%
  list_parse()

Spider Plot

Code 
hc_spiderplot <- highchart() %>%
  hc_chart(polar = TRUE) %>%
  hc_plotOptions(series = list(
    marker = list(enabled = FALSE), animation = TRUE,
    pointIntervalUnit = "month"
  )) %>%
  hc_legend(enabled = FALSE) %>%
  hc_title(text = "", style = list(fontSize = "30px", fontWeight = "bold")) %>%
  hc_xAxis(
    type = "datetime", min = 0, max = 365 * 24 * 36e5,
    labels = list(format = "{value:%B}", style = list(fontSize = "20px"))
  ) %>%
  hc_tooltip(
    headerFormat = "{point.key}", xDateFormat = "%B",
    pointFormat  = " {series.name}: {point.y}"
  ) %>%
  hc_add_series_list(lsseries)

hc_spiderplot

Spider Plot Animated

Code 
lsseries2 <- df %>%
  dplyr::group_by(year) %>%
  dplyr::do(
    data               = .$value,
    color              = "transparent",
    enableMouseTracking = FALSE,
    color2             = dplyr::first(.$color_y)
  ) %>%
  dplyr::mutate(name = year) %>%
  list_parse()

hc_spiderplot_animated <- highchart() %>%
  hc_chart(polar = TRUE) %>%
  hc_plotOptions(series = list(
    marker = list(enabled = FALSE), animation = TRUE,
    pointIntervalUnit = "month"
  )) %>%
  hc_legend(enabled = FALSE) %>%
  hc_title(text = "Timeseries", style = list(fontSize = "30px", fontWeight = "bold")) %>%
  hc_xAxis(
    type = "datetime", min = 0, max = 365 * 24 * 36e5,
    labels = list(format = "{value:%B}", style = list(fontSize = "20px"))
  ) %>%
  hc_tooltip(
    headerFormat = "{point.key}", xDateFormat = "%B",
    pointFormat  = " {series.name}: {point.y}"
  ) %>%
  hc_add_series_list(lsseries2) %>%
  hc_chart(events = list(load = JS("function() {
    var duration = 16 * 1000;
    var delta    = duration / this.series.length;
    var delay    = 500;
    this.series.map(function(e) {
      setTimeout(function() {
        e.update({ color: e.options.color2, enableMouseTracking: true });
        e.chart.setTitle({ text: e.name, style: { fontSize: '24px', fontWeight: 'bold' } });
      }, delay);
      delay = delay + delta;
    });
  }")))

hc_spiderplot_animated

Timeseries by Month

Code 
month_days   <- c(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30)
month_starts <- cumsum(month_days) * 24 * 36e5

hc_timeseries_01 <- hc_spiderplot %>%
  hc_chart(polar = FALSE, type = "spline") %>%
  hc_caption(text = caption_text, style = list(fontSize = "12px", color = "#666666")) %>%
  hc_xAxis(
    type          = "datetime",
    tickPositions = as.list(month_starts),
    labels        = list(
      format   = "{value:%B}",
      rotation = -90,
      style    = list(fontSize = "20px")
    )
  )

hc_timeseries_01

Heatmap

Code 
m <- df %>%
  dplyr::select(year, month, value) %>%
  tidyr::spread(year, value) %>%
  dplyr::select(-month) %>%
  as.matrix()
rownames(m) <- month.abb
m <- remove_nc(m, value = -1)

hc_heatmap_large_fonts <- hchart(m) %>%
  hc_colorAxis(stops = color_stops(10, viridis::viridis(10, option = "B")), min = -1, max = 1) %>%
  hc_title(text = "", style = list(fontSize = "20px", fontWeight = "bold")) %>%
  hc_caption(text = caption_text, style = list(fontSize = "12px", color = "#666666")) %>%
  hc_xAxis(
    title  = list(text = NULL),
    labels = list(rotation = -90, style = list(fontSize = "20px"))
  ) %>%
  hc_yAxis(
    title         = list(text = ""),
    tickPositions = FALSE,
    labels        = list(
      enabled = TRUE, format = "{value}", useHTML = TRUE,
      style   = list(fontSize = "20px")
    )
  )

hc_heatmap_large_fonts

Timeseries Full

Code 
dsts <- df %>%
  dplyr::mutate(name = paste(decade, month)) %>%
  dplyr::select(x = tmpstmp, y = value, name)

hc_timeseries_02 <- highchart() %>%
  hc_caption(text = caption_text, style = list(fontSize = "12px", color = "#666666")) %>%
  hc_xAxis(
    type         = "datetime",
    tickInterval = 365.25 * 24 * 36e5,
    labels       = list(
      format   = "{value:%Y}",
      rotation = -90,
      style    = list(fontSize = "20px")
    )
  ) %>%
  hc_yAxis(tickPositions = c(-1.5, 0, 1.5, 2)) %>%
  hc_add_series(
    dsts,
    name      = "Global Temperature",
    type      = "line",
    color     = hex_to_rgba(viridis::viridis(10, option = "B")[7]),
    lineWidth = 1,
    states    = list(hover = list(lineWidth = 1)),
    shadow    = FALSE
  )

hc_timeseries_02

Timeseries Range

Code 
dscr <- df %>%
  dplyr::mutate(name = paste(decade, month)) %>%
  dplyr::select(x = tmpstmp, low = lower, high = upper, name, color = color_y)

hc_timeseries_range <- highchart() %>%
  hc_caption(text = caption_text, style = list(fontSize = "12px", color = "#666666")) %>%
  hc_yAxis(tickPositions = c(-2, 0, 1.5, 2)) %>%
  hc_xAxis(
    type         = "datetime",
    tickInterval = 365.25 * 24 * 36e5,
    labels       = list(
      format   = "{value:%Y}",
      rotation = -90,
      style    = list(fontSize = "20px")
    )
  ) %>%
  hc_add_series(dscr, name = "Global Temperature", type = "columnrange")

hc_timeseries_range