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

library(highcharter)
library(rwf)

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

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

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

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

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

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

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

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