R/extra_viz.R

In cortinah/hockeystick: Download and Visualize Essential Climate Change Data

#' Download and plot essential climate data
#'
#' Plots global "warming stripes" graph in the style popularized by Ed Hawkins, based on temperature anomaly retrieved using `get_temp()`.
#' Function can output stripes chart with legend or a minimal chart. The output ggplot2 object may be further modified.
#'
#'
#' @name warming_stripes
#' @param dataset Name of the tibble generated by `get_temp`
#' @param stripe_only Display legend and axes, defaults to TRUE
#' @param print (boolean) Display warming stripe ggplot2 chart, defaults to TRUE. Use FALSE to not display chart.
#' @param col_strip Color palette to use.  Defaults to Red-Blue RColorBrewer palette.
#'
#' @return Invisibly returns a ggplot2 object with warming stripes
#'
#' @details `warming_stripes` invisibly returns a ggplot2 object with warming stripes chart using data from `get_temp`.
#' By default the chart is also displayed. User may modify color palette or remove axes and legend. Users may further modify the output ggplot2 chart.
#'
#' @import ggplot2
#' @importFrom RColorBrewer brewer.pal
#'
#' @examples
#' \donttest{
#' # Draw with axes and legend
#' stripes <- warming_stripes()
#'
#' # Draw stripes only
#' stripes <- warming_stripes(stripe_only = TRUE)
#'
#' # Don't display, store for further modifications
#' stripes <- warming_stripes(print = FALSE)
#'
#' # Change color palette
#' stripes <- warming_stripes(stripe_only = TRUE, col_strip = viridisLite::viridis(11)) }
#'
#' @author Hernando Cortina, \email{hch@@alum.mit.edu}
#' @references
#' \itemize{
#' \item Climate Lab. 2018. https://www.climate-lab-book.ac.uk/2018/warming-stripes/
#' \item GISS Surface Temperature Analysis (GISTEMP v4): \url{https://data.giss.nasa.gov/gistemp/}
#' \item GISTEMP Team, 2020: \emph{GISS Surface Temperature Analysis (GISTEMP), version 4.} NASA Goddard Institute for Space Studies.
#' \item Dr. Dominic Roye blog post "How to Create Warming Stripes in R": https://dominicroye.github.io/en/2018/how-to-create-warming-stripes-in-r/
#'  }
#'
#' @export

warming_stripes <- function(dataset = get_temp(), stripe_only = FALSE,
                            col_strip = RColorBrewer::brewer.pal(11, "RdBu"),
                            print = TRUE) {

if (is.null(dataset)) return(invisible(NULL))

theme_strip <- function() theme_bw(base_size=12) +
  theme(axis.text.y = element_blank(),
        axis.line.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title = element_blank(),
        panel.grid.major = element_blank(),
        legend.title = element_blank(),
        axis.text.x = element_text(vjust = 0.5, angle = -90),
        panel.grid.minor = element_blank()
  )

if (!stripe_only) {
plot <- ggplot(dataset, aes(x = Year, y = 0, fill = `J-D`)) +
  geom_tile(height=2.6) +
  scale_x_date(date_breaks = "20 years", date_labels = "%Y", expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_fill_gradientn(colors = rev(col_strip)) +
  guides(fill = guide_colorbar(barwidth = 1)) +
  labs(title = "Global surface temperature anomaly",
       subtitle= "Relative to 1951-1980 average",
       caption = 'Source: NASA Goddard Institute for Space Studies\nhttps://data.giss.nasa.gov/gistemp/') +
  theme_strip() } else

              {
plot <- ggplot(dataset, aes(x = Year, y = 1, fill = `J-D`)) +
  geom_tile(show.legend = FALSE) + scale_x_date(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_fill_gradientn(colors = rev(col_strip)) +
  theme_void() }

if (print) suppressMessages( print(plot) )
invisible(plot)
}


#' Download and plot essential climate data
#'
#' Plots a 2x2 grid of carbon, temperature, sea ice, and sea level charts.
#'
#'
#' @name climate_grid
#' @param print (boolean) Display climate grid ggplot2 chart, defaults to TRUE. Use FALSE to not display chart.
#'
#' @return Invisibly returns a ggplot2 object with climate grid
#'
#' @details `warming_stripes` invisibly returns a ggplot2 object with 2x2 grid of carbon, temperature, sea ice, and sea level charts from `get_carbon`, `get_temp`, `get_seaice`, and `get_sealevel`.
#' By default the chart is also displayed. Users may further modify the output ggplot2 chart.
#'
#' @import ggplot2
#' @import patchwork
#'
#' @examples
#' \donttest{
#' # Draw grid
#'
#' grid <- climate_grid() }
#'
#' @author Hernando Cortina, \email{hch@@alum.mit.edu}
#'
#' @export

climate_grid <- function(print = TRUE) {

  a <- plot_carbon(print = FALSE, annot=FALSE) +theme_bw(base_size = 9)

    b <- plot_temp(print = FALSE) +theme_bw(base_size = 9) +theme(legend.position = "none") +
    labs(title='Global Land-Ocean Temperature Index', subtitle='Global surface temperature relative to 1951-80 mean',
         y='Temperature Anomaly (C\U00B0)', caption='Source: NASA Goddard Institute for Space Studies\nhttps://data.giss.nasa.gov/gistemp/')
  c <- suppressMessages( plot_seaice(print = FALSE) +theme_bw(base_size = 9) )

  d <- plot_sealevel(print = FALSE)

  if (is.null(a) | is.null(b) | is.null(c) | is.null(d)) return(invisible(NULL))

  d <- d +  labs(title='Sea Level Rise', subtitle='Tide gauges: 1880-2009; Satellite: 1992-present.', y= 'Variation (mm)',
         caption='Sources: NOAA Laboratory for Satellite Altimetry (sat)\nhttps://www.star.nesdis.noaa.gov/socd/lsa/SeaLevelRise\nCSIRO (tide gauge)\nhttp://www.cmar.csiro.au/sealevel/sl_data_cmar.html') +theme_bw(base_size = 9) +theme(legend.position = "none")

  plot <- patchwork::wrap_plots(a, b, c, d, ncol = 2) + patchwork::plot_annotation(title='Carbon and Global Warming')

  if (print) suppressMessages( print(plot) )
  invisible(plot)
}



#' Download and plot essential climate data
#'
#' Plots a treemap of cumulative co2 emissions by country since 1900.
#'
#'
#' @name emissions_map
#' @param dataset Name of the tibble generated by `get_emissions`
#' @param print (boolean) Display emissions treemap, defaults to TRUE. Use FALSE to not display chart.
#' @param since (numeric) Start year for cumulative emissions, defaults to 1900 if omitted
#' @param number (numeric) Number of countries to display in treemap, defaults to all if omitted
#' @param title (string) Manually specify chart title
#'
#' @return Invisibly returns a ggplot2 object with emissions treemap
#'
#' @details `emissions_map` invisibly returns a ggplot2 object with cumulative emissions treemap by country since 1900 from `get_emissions`.
#' By default the chart is also displayed. Users may further modify the output ggplot2 chart.
#'
#' @import ggplot2
#' @import dplyr
#' @import treemapify
#'
#' @examples
#' \donttest{
#' # Draw treemap
#'
#' co2map <- emissions_map()
#'
#' co2map <- emissions_map(since=2000, number=20, title="Top 20 Cumulative Emitters Since 2000") }
#'
#' @author Hernando Cortina, \email{hch@@alum.mit.edu}
#'
#' @export


emissions_map <- function(dataset=get_emissions(), print = TRUE, since=1900, number="all",
                          title = substitute(paste(since,'-',to,' Cumulative '*CO[2]*" Emissions by Country"),
                                             list(since=since, to=as.character(dataset[nrow(dataset), 2])))) {

  if (is.null(dataset)) return(invisible(NULL))

  treemap <- dataset |> filter(year >= since) |> group_by(country) |>
    summarize(cumco2=sum(co2, na.rm = T)) |> arrange(-cumco2) |>
    filter(!grepl("World|Europe|Asia|Africa|America|OECD|transport|Oceania|Middle|countries", country))

  if(number!="all") treemap <- slice_head(treemap, n=number)

  plot <- ggplot(treemap, aes(area = cumco2, fill = cumco2, label = country)) + theme_minimal(base_size = 14) +
    geom_treemap() + geom_treemap_text(color=c("white", "black", rep("white", nrow(treemap)-2))) + scale_fill_viridis_c(option = "H") +
    theme(legend.position = "none") +
    labs(title = title, caption="Source: Global Carbon Project and Our World In Data")

  if (print) suppressMessages( print(plot) )
  invisible(plot)
}

#' Download and plot essential climate data
#'
#' Merge NOAA carbon and NASA temperature datasets on common dates.
#'
#'
#' @name merge_carbontemp
#' @param carbon Name of the tibble generated by `get_carbon`
#' @param temp Name of the tibble generated by `get_temp`
#'
#' @return Invisibly returns a tibble with merged datasets from `get_carbon` and `get_temp` functions.
#'
#' @details `merge_carbontemp` invisibly returns a tibble with the merged data from from `get_carbon` and `get_temp` functions.
#' Tibble only includes data from dates when both datasets are available, essentially from 1960.
#'
#' @import lubridate
#' @import dplyr
#'
#' @examples
#' \donttest{
#' # Create merged tibble
#'
#' mergedcarbontemp <- merge_carbontemp() }
#'
#'
#' @author Hernando Cortina, \email{hch@@alum.mit.edu}
#'
#' @export

merge_carbontemp <- function(carbon=get_carbon(), temp=get_temp() ) {

  if (is.null(carbon) | is.null(temp)) return(invisible(NULL))

temp <- temp |> select(1:13) |> tidyr::pivot_longer(cols = 2:13, names_to = 'Month', values_to = 'Anomaly') |>
  filter(!is.na(Anomaly))

temp <- temp |> mutate(Date = ceiling_date(lubridate::ym(paste(year(Year), Month)), 'month') - days(1)) |>
  select(Date, Anomaly)

carbon <- carbon |> select(Date=date, Year=year, Carbon=average)

output <- inner_join(carbon, temp, by='Date')

return(invisible(output))  }




#' Download and plot essential climate data
#'
#' Plots the global monthly mean temperature anomaly vs atmospheric carbon  with ggplot2. The output ggplot2 object may be further modified.
#'
#'
#' @name plot_carbontemp
#' @param dataset Name of the tibble generated by `merge_carbontemp`
#' @param print (boolean) Display temperature anomaly ggplot2 chart, defaults to TRUE. Use FALSE to not display chart.
#'
#' @return Invisibly returns a ggplot2 object with temperature anomaly vs carbon chart
#'
#' @details `plot_carbontemp` invisibly returns a ggplot2 object with a pre-defined temperature anomaly vs carbon chart using data from `merge_carbontemp`.
#' By default the chart is also displayed. Users may further modify the output ggplot2 chart.
#'
#' @importFrom ggplot2 ggplot
#'
#' @examples
#' \donttest{
#' # Fetch temperature anomaly:
#' mergedtemp <- merge_carbontemp()
#' #
#' # Plot output using package's built-in ggplot2 defaults
#' plot_carbontemp(mergedtemp)
#'
#' # Or just call plot_carbontemp(), which defaults to merge_carbontemp() dataset
#' plot_carbontemp()
#'
#' p <- plot_carbontemp(mergedtemp, print = FALSE)
#' # Modify plot such as: p + ggplot2::labs(title='The Signature of Climate Change') }
#'
#' @author Hernando Cortina, \email{hch@@alum.mit.edu}
#'
#' @export

plot_carbontemp <- function(dataset = merge_carbontemp(), print=TRUE) {

  if (is.null(dataset)) return(invisible(NULL))

  plot <- ggplot(dataset, aes(x=Carbon, y=Anomaly, color=Year)) + geom_point() + theme_bw() + scale_y_continuous(n.breaks = 8) +
    scale_color_fermenter(palette = "YlOrRd", direction = 1, labels=c('1960-70s', '1980-90s', '2000-10s', '2020-40s')) +
    theme(legend.key.height = unit(1,"cm"), legend.text = element_text(vjust = -1.5)) +
    labs(title=expression('Global Heating and Atmospheric '*CO[2]*' Since 1959'),
         subtitle='Monthly temperature relative to 1951-80 mean and Mauna Loa monthly mean', x=expression(title='Atmospheric '*CO[2]*' (ppm)'),
         y='Global Temperature Anomaly (C\U00B0)', color='20-year\nperiods',
         caption='Sources: NASA Goddard Institute for Space Studies\nNOAA/ESRL and Scripps Institution of Oceanography')

  if (print) suppressMessages( print(plot) )
  invisible(plot)
}