Day 25 2024 #30daymapchallenge code

gistfile1.txt

library(rvest)
library(dplyr)
library(RcppRoll)
library(tidygeocoder)
library(maps)
library(mapdata)
library(ggplot2)
library(viridis)
library(patchwork)
library(ggtext)
#Timeseries of UN Climate Change COP meetings and global annual temperature.
# I worked out from the later distribution of timeCOP data a good discrete distribution
# is 20 steps, using 13 of those steps over the 30 COP entries. So I made it easy
# for myself and made the title and subtitle multiples of 30 characters then added
#colour info for ggtext element_markdown
twentycols <- viridis_pal(alpha = 1, begin = 0, option="A", end=0.92, direction = 1)(20)
sbtitle <- paste0("<span style='color:",twentycols[1],"'>G</span>",
                  "<span style='color:",twentycols[2],"'>lo</span>",
                  "<span style='color:",twentycols[3],"'>b</span>",
                  "<span style='color:",twentycols[4],"'>al w</span>",
                  "<span style='color:",twentycols[5],"'>a</span>",
                  "<span style='color:",twentycols[6],"'>rm</span>",
                  "<span style='color:",twentycols[7],"'>ing (<SUP>o</SUP>C)</span>",
                  "<span style='color:",twentycols[9],"'> s</span>",
                  "<span style='color:",twentycols[11],"'>inc</span>",
                  "<span style='color:",twentycols[12],"'>e</span>",
                  "<span style='color:",twentycols[13],"'> C</span>",
                  "<span style='color:",twentycols[15],"'>OP</span>",
                  "<span style='color:",twentycols[20],"'>1</span>")
mdtitle <- paste0("<span style='color:",twentycols[1],"'>He</span>",
                  "<span style='color:",twentycols[2],"'>atin</span>",
                  "<span style='color:",twentycols[3],"'>g </span>",
                  "<span style='color:",twentycols[4],"'>up: U.N.</span>",
                  "<span style='color:",twentycols[5],"'> C</span>",
                  "<span style='color:",twentycols[6],"'>lima</span>",
                  "<span style='color:",twentycols[7],"'>te Change Confer</span>",
                  "<span style='color:",twentycols[9],"'>ence</span>",
                  "<span style='color:",twentycols[11],"'>s and </span>",
                  "<span style='color:",twentycols[12],"'>gl</span>",
                  "<span style='color:",twentycols[13],"'>obal</span>",
                  "<span style='color:",twentycols[15],"'> tem</span>",
                  "<span style='color:",twentycols[20],"'>p.</span>")
# see if the prepared timeseries of COP meetings has already been processed
if(!file.exists("timecop.csv")){
  # https://en.wikipedia.org/wiki/United_Nations_Climate_Change_Conference
  # read page and pull out meetings.
  page = read_html("https://en.wikipedia.org/wiki/United_Nations_Climate_Change_Conference")
  tableOnPage = html_node(page, ".wikitable")
  summits = html_table(tableOnPage, fill = TRUE)
  unclimate <- summits[grep("COP",summits$Name),]
  # look up COP locations in OpenStreetMap to get latitude and longitude
  cccun <- geocode(unclimate,city=Location, country=Country, 
                   method = "osm", 
                   limit=1, full_results = TRUE)
  # https://www.ncei.noaa.gov/products/land-based-station/noaa-global-temp
  # https://www.ncei.noaa.gov/data/noaa-global-surface-temperature/v6/access/timeseries/aravg.mon.land_ocean.90S.90N.v6.0.0.202410.asc
  # pull the ascii file of world monthly average land & sea temperature directly into R
  monthly_global_temp <- read.table("https://www.ncei.noaa.gov/data/noaa-global-surface-temperature/v6/access/timeseries/aravg.mon.land_ocean.90S.90N.v6.0.0.202410.asc")
  # getting the rolling average of monthly averages is close enough
  # to the annual average at this level of resolution, and lets us do
  # year to October to include 2024
  # then join all the data on the basis of years
  combo <- monthly_global_temp |> 
    mutate(rolling_annual_temp = roll_meanr(monthly_global_temp$V3, n = 12)) |>
    filter(V2 == 10) |> 
    select(Year=V1,rolling_annual_temp) |> 
    inner_join(cccun, by="Year") |> 
    mutate(changeT=rolling_annual_temp-rolling_annual_temp[1],
           nextlat=lead(lat),
           nextlong = lead(long),
           nextYear = lead(Year),
           midtemp = (changeT + lead(changeT))/2,
           nextTemp = lead(changeT)) |> 
    select(Year, Name, Location, Country, lat,long, changeT,
           nextlat, nextlong, nextYear, nextTemp, midtemp)
  write.csv(combo, file = "timecop.csv", row.names=FALSE)
}
# load the cached copy of data that must exist by now
timeCOP <- read.csv("timecop.csv") 
# basic background map
world <- map_data("world")
plot1 <- ggplot(world, aes(long, lat)) +
  geom_polygon(aes(group = group),
               fill="#EEE",colour="#EEE") +
  geom_curve(data=timeCOP[1:29,],aes(xend=nextlong,yend=nextlat, colour=midtemp)) +
  geom_point(data=timeCOP, aes(colour=changeT)) +
  scale_colour_viridis_c(option="A", end=0.92) +
  theme_void() +
  coord_fixed(xlim=c(-90,140), 
              ylim=c(-45,70)) +
  theme(legend.position = "none")

plot2 <- ggplot(timeCOP, aes(x=Year, y=changeT)) +
  annotate("text", x=1995, y=0.7, hjust=0, colour="#BBB",
           label="Warming in global annual average degrees C since COP1 (1995)") +
  geom_point(aes(colour=changeT)) +
  geom_segment(data=timeCOP[1:29,],aes(xend=nextYear,yend=nextTemp, colour=midtemp)) +
  scale_colour_viridis_c(option="A", end=0.92) +
  theme_minimal() + 
  theme(legend.position = "none", 
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        axis.ticks.x.bottom = element_line(colour="#BBB", linewidth=0.5),
        axis.ticks.length.x = unit(12, "pt"),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x.bottom = element_text(margin=margin(6,6,6,6)),
        axis.text.y.left = element_text(margin=margin(6,6,6,6))) +
  scale_y_continuous(breaks=c(0,.5)) + scale_x_continuous(breaks=c(2000,2020))

design <- "A
           A
           A
           B"

twoplots <- plot1 + plot2 +
  plot_layout(design = design) +
  plot_annotation(title=mdtitle,
                  subtitle=sbtitle,
                  theme = theme(plot.subtitle = element_markdown(),
                                plot.title = element_markdown()),
                  caption = "COPs: Wikipedia, Coordinations: OSM, Temperature: NCEI/NOAA")

ggsave(filename="~/Desktop/heat.jpg", plot=twoplots,
       height=600, width=900, dpi=150, units="px")